1% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_first.pl 2%:- if((prolog_load_context(source,F),prolog_load_context(file,F))). 3:- module(first, 4 [ pi_to_head_l/2, 5 safe_numbervars/1, 6 safe_numbervars/2, 7 put_variable_names/1, 8 nput_variable_names/1, 9 check_variable_names/2, 10 unnumbervars4/4, 11 get_varname_list/1, 12 cfunctor/3, 13 set_varname_list/1, 14 on_xf_cont/1, 15 user_ensure_loaded/1, 16 user_use_module/1, 17 dupe_term/2, 18 alldiscontiguous/0, 19 arg_is_transparent/1, 20 maybe_fix_varnumbering/2, 21 all_module_predicates_are_transparent/1, 22 alldiscontiguous/0, 23 arg_is_transparent/1, 24 module_meta_predicates_are_transparent/1, 25 module_predicate/3, 26 module_predicate/4, 27 module_predicates_are_exported/0, 28 module_predicates_are_exported/1, 29 module_predicates_are_exported0/1, 30 module_predicates_are_not_exported_list/2, 31 quiet_all_module_predicates_are_transparent/1, 32 export_all_preds/0, 33 export_all_preds/1, 34 35 36 if_may_hide/1, 37 match_predicates/2, 38 match_predicates/5, 39 mpred_trace_childs/1, 40 mpred_trace_less/1, 41 mpred_trace_nochilds/1, 42 mpred_trace_none/1, 43 44 add_newvar/2, 45 add_newvars/1, 46 47 %lbl_vars/6, 48 49 mustvv/1, 50 name_to_var/3, 51 source_context_module/1, 52 53 54 % tlbugger:ifHideTrace/0, 55 register_var/3, 56 register_var/4, 57 register_var_0/4, 58 remove_grounds/2, 59 renumbervars_prev/2, 60 renumbervars1/2, 61 renumbervars1/4, 62 add_var_to_env/2, 63 64 samify/2, 65 snumbervars/1, 66 snumbervars/3, 67 snumbervars/4, 68 term_to_string/2, 69 unnumbervars/2, 70 unnumbervars_and_save/2, 71 %qdmsg/1, 72 getenv_safe/3, 73 var_to_name/3 74 75 ]). 76%:- endif. 77 78 79:- set_module(class(library)). 80old_set_predicate_attribute(M:F/A, Name, Val):- functor(P,F,A), !, old_set_predicate_attribute(M:P, Name, Val). 81%old_set_predicate_attribute(MA, system, Val):- !, old_set_predicate_attribute(MA, iso, Val). 82old_set_predicate_attribute(MA, Name, Val) :- 83 catch('$set_predicate_attribute'(MA, Name, Val),error(E, _), (print_message(error, error(E, context(Name/1, _))))). 84 85 86old_get_predicate_attribute(M:F/A, Name, Val):- functor(P,F,A), !, old_get_predicate_attribute(M:P, Name, Val). 87%old_get_predicate_attribute(MA, system, Val):- !, old_get_predicate_attribute(MA, iso, Val). 88old_get_predicate_attribute(MA, Name, Val) :- 89 catch('$get_predicate_attribute'(MA, Name, Val),error(E, _), (print_message(error, error(E, context(Name/1, _))))). 90 91:- meta_predicate('$with_unlocked_pred_local'(,)). 92'$with_unlocked_pred_local'(_,Goal):- !, current_prolog_flag(access_level,Was), 93 setup_call_cleanup(set_prolog_flag(access_level,system),Goal,set_prolog_flag(access_level,Was)). 94/*'$with_unlocked_pred_local'(MP,Goal):- strip_module(MP,M,P),Pred=M:P, 95 (predicate_property(Pred,foreign)-> true ; 96 ( 97 ('old_get_predicate_attribute'(Pred, system, OnOff)->true;throw('old_get_predicate_attribute'(Pred, system, OnOff))), 98 (==(OnOff,0) -> Goal ; 99 setup_call_cleanup('old_set_predicate_attribute'(Pred, system, 0), 100 catch(Goal,E,throw(E)),'old_set_predicate_attribute'(Pred, system, 1))))). 101 */ 102 103:- meta_predicate(totally_hide()). 104totally_hide(_):-!. 105totally_hide(CM:F/A):- cfunctor(P,F,A),!, 106 (predicate_property(CM:P,imported_from(M));M=CM), 107 Pred=M:P,!, 108 % (current_prolog_flag(runtime_debug,N), N>2) -> unhide(Pred) ; 109 '$with_unlocked_pred_local'(Pred, 110 (('$hide'(M:F/A),'old_set_predicate_attribute'(Pred, trace, 0), 111 'old_set_predicate_attribute'(Pred, iso, 1), 112 'old_set_predicate_attribute'(Pred, hide_childs, 1)))). 113totally_hide(MP):- strip_module(MP,CM,P),cfunctor(P,F,A),!,totally_hide(CM:F/A). 114 115set_pred_attrs(M:F/A,List):- cfunctor(P,F,A),!,set_pred_attrs(M:P,List). 116set_pred_attrs(MP,N=V):- !, strip_module(MP,CM,P), 117 (predicate_property(MP,imported_from(M));M=CM), 118 Pred=M:P,!, 119 '$with_unlocked_pred_local'(Pred,old_set_predicate_attribute(Pred,N,V)). 120set_pred_attrs(MP,List):- maplist(set_pred_attrs(MP),List). 121 122:- 'set_pred_attrs'(catch(_,_,_),[trace=0,hide_childs=0]). 123 124:- thread_local(tlbugger:ifHideTrace/0).% WAS OFF :- system:reexport(library(logicmoo/util_varnames)). 125% % % OFF :- system:use_module(library(lists)). 126 127:- export(reset_IO/0). 128reset_IO:- 129 stream_property(In,file_no(0)),stream_property(Out,file_no(1)),stream_property(Err,file_no(2)), 130 set_stream(In,buffer(line)),set_stream(Out,buffer(false)),set_stream(Err,buffer(false)), 131 set_stream(In,alias(current_input)),set_stream(Out,alias(current_output)),set_stream(Err,alias(current_error)), 132 set_stream(current_input,buffer(line)),set_stream(current_output,buffer(false)),set_stream(current_error,buffer(false)), 133 set_stream(In,alias(user_input)),set_stream(Out,alias(user_output)),set_stream(Err,alias(user_error)), 134 set_stream(user_input,buffer(line)),set_stream(user_output,buffer(false)),set_stream(user_error,buffer(false)), 135 set_output(Out), 136 set_system_IO(In,Out,Err), 137 set_prolog_IO(In,Out,Err), 138 writeln(Out,Out), 139 writeln(user_output,user_output), 140 wdmsg(reset_IO), 141 writeln(user_error,user_error). 142 143 144:- export(cnas/3). 145 146% cnas(A,B,C):- compound_name_args_safe(A,B,C). 147cnas(A,B,C):- compound(A)-> compound_name_arguments(A,B,C);( A=..[B|C]). 148cfunctor(A,B,C):- compound(A)->compound_name_arity(A,B,C);functor(A,B,C). 149 150:- system:import(cnas/3). 151:- system:import(cfunctor/3). 152:- system:export(cfunctor/3). 153%:- system:reexport(library(must_sanity)). 154 155 156 157getenv_safe(Name,ValueO,Default):- 158 (getenv(Name,RV)->Value=RV;Value=Default), 159 (number(Default)->( \+ number(Value) -> atom_number(Value,ValueO); Value=ValueO);(Value=ValueO)).
167pi_to_head_l(I,O):-var(I),!,I=O. 168pi_to_head_l(I,O):-var(I),!,trace_or_throw(var_pi_to_head_l(I,O)). 169pi_to_head_l(M:PI, M:Head) :- !, 170 pi_to_head_l(PI, Head). 171pi_to_head_l(Name/Arity, Head) :- !, 172 must(cfunctor(Head, Name, Arity)). 173pi_to_head_l(Name//DCGArity, Term) :- 174 Arity is DCGArity+2, 175 must(cfunctor(Term, Name, Arity)). 176pi_to_head_l(Head, Head). 177 178:- meta_predicate 179 180 if_may_hide(), 181 match_predicates(, ), 182 match_predicates(,,,,), 183 mpred_trace_none(), 184 mpred_trace_less(), 185 mpred_trace_childs(), 186 mpred_trace_nochilds(), 187 188 mustvv(), 189 on_xf_cont(), 190 renumbervars_prev(, ), 191 snumbervars(), 192 snumbervars(, , ), 193 snumbervars(, , , ). 194:- module_transparent 195source_context_module/1, 196 197user_ensure_loaded/1, 198on_xf_cont/1, 199user_use_module/1, 200alldiscontiguous/0, 201arg_is_transparent/1, 202all_module_predicates_are_transparent/1, 203alldiscontiguous/0, 204arg_is_transparent/1, 205module_meta_predicates_are_transparent/1, 206module_predicate/3, 207module_predicate/4, 208module_predicates_are_exported/0, 209module_predicates_are_exported/1, 210module_predicates_are_exported0/1, 211module_predicates_are_not_exported_list/2, 212quiet_all_module_predicates_are_transparent/1, 213 214 match_predicates/2, 215 match_predicates/5, 216 if_may_hide/1, 217 mpred_trace_less/1, 218 mpred_trace_none/1, 219 mpred_trace_nochilds/1, 220 mpred_trace_childs/1, 221 add_newvar/2, 222 add_newvars/1, 223 %lbl_vars/6, 224 name_to_var/3, 225 register_var/3, 226 register_var/4, 227 register_var_0/4, 228 remove_grounds/2, 229 renumbervars1/2, 230 renumbervars1/4, 231 samify/2, 232 233 term_to_string/2, 234 unnumbervars/2, 235 add_var_to_env/2, 236 safe_numbervars/1, 237 safe_numbervars/2, 238 unnumbervars_and_save/2, 239 var_to_name/3. 240 241 242:- meta_predicate snumbervars(,,,). 243:- meta_predicate snumbervars(,,). 244:- meta_predicate safe_numbervars(). 245/* 246 module_meta_transparent(:), 247 some_flocation/3, 248 249:- meta_predicate contains_singletons(?). 250% Restarting analysis ... 251% Found new meta-predicates in iteration 2 (0.206 sec) 252:- meta_predicate renumbervars_prev(?,?). 253:- meta_predicate randomVars(?). 254:- meta_predicate snumbervars(?). 255% Restarting analysis ... 256% Found new meta-predicates in iteration 3 (0.121 sec) 257:- meta_predicate programmer_error(0). 258:- meta_predicate safe_numbervars(*,?). 259 export_file_preds/1, 260 export_file_preds/6, 261 export_file_preds/0, 262some_location/3, 263*/ 264 265%=
271alldiscontiguous:-!. 272 273 274%=
280source_context_module(M):- source_context_module0(M),M\==user, \+ '$current_typein_module'(M),!. 281source_context_module(M):- source_context_module0(M),M\==user,!. 282source_context_module(M):- source_context_module0(M). 283 284source_context_module0(M):- context_module(M). 285source_context_module0(M):- prolog_load_context(module, M). 286source_context_module0(M):- '$current_typein_module'(M). 287 288 289 290:-export(on_x_fail/1).
295on_x_fail(Goal):- catchv(Goal,_,fail). 296 297 298%================================================================ 299% pred tracing 300%================================================================ 301 302% = :- meta_predicate('match_predicates'(:,-)). 303 304 305%=
311match_predicates(M:Spec,Preds):- catch('$find_predicate'(M:Spec, Preds),_,catch('$find_predicate'(Spec, Preds),_,catch('$find_predicate'(baseKB:Spec, Preds),_,fail))),!. 312match_predicates(MSpec,MatchesO):- catch('$dwim':'$find_predicate'(MSpec,Matches),_,Matches=[]),!,MatchesO=Matches. 313 314 315%=
321match_predicates(_:[],_M,_P,_F,_A):-!,fail. 322match_predicates(IM:(ASpec,BSpec),M,P,F,A):-!, (match_predicates(IM:(ASpec),M,P,F,A);match_predicates(IM:(BSpec),M,P,F,A)). 323match_predicates(IM:[ASpec|BSpec],M,P,F,A):-!, (match_predicates(IM:(ASpec),M,P,F,A);match_predicates(IM:(BSpec),M,P,F,A)). 324match_predicates(IM:IF/IA,M,P,F,A):- '$find_predicate'(IM:P,Matches),member(CM:F/A,Matches),functor(P,F,A),(predicate_property(CM:P,imported_from(M))->true;CM=M),IF=F,IA=A. 325match_predicates(Spec,M,P,F,A):- '$find_predicate'(Spec,Matches),member(CM:F/A,Matches),functor(P,F,A),(predicate_property(CM:P,imported_from(M))->true;CM=M). 326 327:- module_transparent(if_may_hide/1). 328% = :- meta_predicate(if_may_hide(0)). 329%if_may_hide(_G):-!. 330 331%=
337if_may_hide(G):-call(G). 338 339:- meta_predicate with_unlocked_pred(,). 340 341%=
347with_unlocked_pred(MP,Goal):- strip_module(MP,M,P),Pred=M:P, 348 (predicate_property(Pred,foreign)-> true ; 349 ( 350 ('old_get_predicate_attribute'(Pred, system, 0) -> ; 351 setup_call_cleanup('old_set_predicate_attribute'(Pred, system, 0), 352 catch(Goal,E,throw(E)),'old_set_predicate_attribute'(Pred, system, 1))))). 353 354 355on_xf_cont(Goal):- ignore(catch(Goal,_,true)). 356 357:- export(mpred_trace_less/1). 358 359%=
365mpred_trace_less(W):- if_may_hide(forall(match_predicates(W,M,Pred,_,_),( 366 with_unlocked_pred(M:Pred,( 367 'old_set_predicate_attribute'(M:Pred, noprofile, 1), 368 (A==0 -> 'old_set_predicate_attribute'(M:Pred, hide_childs, 1);'old_set_predicate_attribute'(M:Pred, hide_childs, 1)), 369 (A==0 -> 'old_set_predicate_attribute'(M:Pred, trace, 0);'old_set_predicate_attribute'(M:Pred, trace, 1))))))). 370 371:- export(mpred_trace_none/1). 372 373%=
379mpred_trace_none(W):- (forall(match_predicates(W,M,Pred,F,A), 380 with_unlocked_pred(M:Pred,(('$hide'(M:F/A),'old_set_predicate_attribute'(M:Pred, hide_childs, 1),noprofile(M:F/A),nop(nospy(M:Pred))))))). 381 382:- export(mpred_trace_nochilds/1). 383 384%=
390mpred_trace_nochilds(W):- if_may_hide(forall(match_predicates(W,M,Pred,_,_),( 391 with_unlocked_pred(M:Pred,( 392 'old_set_predicate_attribute'(M:Pred, trace, 1), 393 %'old_set_predicate_attribute'(M:Pred, noprofile, 0), 394 'old_set_predicate_attribute'(M:Pred, hide_childs, 1)))))). 395 396:- export(mpred_trace_childs/1).
404mpred_trace_childs(W) :- if_may_hide(forall(match_predicates(W,M,Pred,_,_),( 405 with_unlocked_pred(M:Pred,( 406 'old_set_predicate_attribute'(M:Pred, trace, 0), 407 %'old_set_predicate_attribute'(M:Pred, noprofile, 0), 408 'old_set_predicate_attribute'(M:Pred, hide_childs, 0)))))). 409 410 411%=
417mpred_trace_all(W) :- forall(match_predicates(W,M,Pred,_,A),( 418 with_unlocked_pred(M:Pred,( 419 (A==0 -> 'old_set_predicate_attribute'(M:Pred, trace, 0);'old_set_predicate_attribute'(M:Pred, trace, 1)), 420 % 'old_set_predicate_attribute'(M:Pred, noprofile, 0), 421'old_set_predicate_attribute'(M:Pred, hide_childs, 0))))). 422 423%:-mpred_trace_all(prolog:_). 424%:-mpred_trace_all('$apply':_). 425%:-mpred_trace_all(system:_). 426 427%:- set_module(class(library)). 428 429 430%:- thread_local(tlbugger:ifHideTrace/0). 431%:- export(tlbugger:ifHideTrace/0).
439oncely_clean(Goal):- 440 '$sig_atomic'((Goal,assertion(deterministic(true)))) 441 ->true; 442 throw(failed_oncely_clean(Goal)). 443 444 445 446%=
453term_to_string(IS,I):- on_x_fail(term_string(IS,I)),!. 454term_to_string(I,IS):- on_x_fail(string_to_atom(IS,I)),!. 455term_to_string(I,IS):- rtrace(term_to_atom(I,A)),string_to_atom(IS,A),!. 456 457 458:- meta_predicate mustvv(). 459 460%=
466mustvv(G):-must(G). 467 468%:- export(unnumbervars/2). 469% unnumbervars(X,YY):- lbl_vars(_,_,X,[],Y,_Vs),!, mustvv(YY=Y). 470% TODO compare the speed 471% unnumbervars(X,YY):- mustvv(unnumbervars0(X,Y)),!,mustvv(Y=YY). 472 473 474dupe_term(E,EE):- duplicate_term(E,EE),E=EE. 475 476get_varname_list(VsOut,'$variable_names'):- nb_current('$variable_names',Vs),Vs\==[],!,check_variable_names(Vs,VsOut),!. 477get_varname_list(VsOut,'$old_variable_names'):- nb_current('$old_variable_names',Vs),Vs\==[],!,check_variable_names(Vs,VsOut),!. 478 479get_varname_list(VsOut):- get_varname_list(VsOut,_),!. 480get_varname_list([]). 481 482set_varname_list(VsIn):- check_variable_names(VsIn,Vs), 483 b_setval('$variable_names',[]), 484 dupe_term(Vs,VsD), 485 nb_linkval('$variable_names',VsD). 486 487add_var_to_env(NameS,Var):- 488 ((is_list(NameS);string(NameS))->name(Name,NameS);NameS=Name), 489 get_varname_list(VsIn), 490 add_var_to_list(Name,Var,VsIn,_NewName,NewVar,NewVs), 491 % (NewName\==Name -> put_attr(Var, vn, NewName) ; true), 492 (NewVar \==Var -> put_attr(NewVar, vn, Name) ; true), 493 (NewVs \==VsIn -> put_variable_names(NewVs) ; true).
497add_var_to_list(Name,Var,Vs,NewName,NewVar,NewVs):- member(N0=V0,Vs), Var==V0,!, 498 (Name==N0 -> ( NewName=Name,NewVar=Var, NewVs=Vs ) ; ( NewName=N0,NewVar=Var,NewVs=[Name=Var|Vs])),!. 499% a current name but points to a diffentrt var 500add_var_to_list(Name,Var,Vs,NewName,NewVar,NewVs):- member(Name=_,Vs), 501 length(Vs,Len),atom_concat(Name,Len,NameAgain0),( \+ member(NameAgain0=_,Vs)-> NameAgain0=NameAgain ; gensym(Name,NameAgain)), 502 NewName=NameAgain,NewVar=Var, 503 NewVs=[NewName=NewVar|Vs],!. 504add_var_to_list(Name,Var,Vs,NewName,NewVar,NewVs):- 505 NewName=Name,NewVar=Var,NewVs=[Name=Var|Vs],!. 506 507 508%=
514unnumbervars(X,Y):- must(zotrace(unnumbervars_and_save(X,Y))). 515 516:- export(zotrace/1). 517zotrace(G):- call(G). 518:- module_transparent(zotrace/1). 519%zotrace(G):- notrace(tracing)->notrace(G);call(G). 520:- '$hide'(zotrace/1). 521:- 'old_set_predicate_attribute'(zotrace/1, hide_childs, true). 522 523first_scce_orig(Setup0,Goal,Cleanup0):- 524 notrace((Cleanup = notrace('$sig_atomic'(Cleanup0)),Setup = notrace('$sig_atomic'(Setup0)))), 525 notrace(Setup), !, 526 (catch(Goal, E,(Cleanup,throw(E))) 527 *-> (notrace(tracing)->(notrace,deterministic(DET),trace);deterministic(DET)); notrace((Cleanup,!,fail))), 528 , 529 (notrace(DET == true) -> ! ; (true;(,notrace(fail)))). 530 531zzotrace(G):- 532 notrace(\+ tracing) ->call(G) ; first_scce_orig(notrace,G,trace). 533:- '$hide'(zzotrace/1). 534 535put_variable_names(NewVs):- check_variable_names(NewVs,Checked),call(b_setval,'$variable_names',Checked). 536nput_variable_names(NewVs):- check_variable_names(NewVs,Checked),call(nb_setval,'$variable_names',Checked). 537 538check_variable_names(I,O):- (\+ (member(N=_,I),var(N)) -> O=I ; 539 (set_prolog_flag(variable_names_bad,true),trace_or_throw(bad_check_variable_names))). 540 541%=
548%unnumbervars_and_save(X,YO):- must(zotrace(unnumbervars4(X,[],_,YO))),!. 549unnumbervars_and_save(X,YO):- unnumbervars4(X,[],_,YO),!. 550% unnumbervars_and_save(X,YO):- \+ ((sub_term(V,X),compound(V),'$VAR'(_)=V)),!,YO=X. 551 552/* 553unnumbervars_and_save(X,YO):- (get_varname_list(Vs)->true;Vs=[]),unnumbervars4(X,Vs,NewVs,YO),!, 554 (NewVs \==Vs -> put_variable_names(NewVs) ; true). 555unnumbervars_and_save(X,YO):- 556 term_variables(X,TV), 557 mustvv((source_variables_l(Vs), 558 with_output_to(string(A),write_term(X,[numbervars(true),variable_names(Vs),character_escapes(true),ignore_ops(true),quoted(true)])))), 559 mustvv(atom_to_term(A,Y,NewVs)), 560 (NewVs==[]-> YO=X ; (length(TV,TVL),length(NewVs,NewVarsL),(NewVarsL==TVL-> (YO=X) ; (add_newvars(NewVs),YO=Y)))). 561*/
568unnumbervars4(PTermIn,VsIn,NewVs,PTermOutO):- nonvar(PTermOutO),!,unnumbervars4(PTermIn,VsIn,NewVs,Var),!, 569 must(PTermOutO=Var),!. 570unnumbervars4(Var,Vs,Vs,OVar):- nonvar(OVar),!,dumpST,throw(unnumbervars4(Var,Vs,Vs,OVar)). 571unnumbervars4(Var,Vs,Vs,Var):- \+ compound(Var), !. 572unnumbervars4([],Vs,Vs,[]):-!. 573unnumbervars4('$VAR'(Name),Vs,Vs,_):- Name=='_',!. 574 575unnumbervars4([I|TermIn],VsIn,NewVs,[O|TermOut]):- !,unnumbervars4(I,VsIn,VsM,O),unnumbervars4(TermIn,VsM,NewVs,TermOut). 576unnumbervars4(Var,Vs,Vs,Var):- compound_name_arity(Var,_,0), !. 577unnumbervars4((I,TermIn),VsIn,NewVs,(O,TermOut)):- !,unnumbervars4(I,VsIn,VsM,O),unnumbervars4(TermIn,VsM,NewVs,TermOut). 578unnumbervars4((I:TermIn),VsIn,NewVs,(O:TermOut)):- !,unnumbervars4(I,VsIn,VsM,O),unnumbervars4(TermIn,VsM,NewVs,TermOut). 579unnumbervars4('$VAR'(Name),VsIn,NewVs,Var):- nonvar(Name),!, (member(Name=Var,VsIn)->NewVs=VsIn;NewVs=[Name=Var|VsIn]),!, 580 put_attr(Var,vn,Name). 581unnumbervars4(PTermIn,VsIn,NewVs,PTermOutO):- compound(PTermIn),!, compound_name_arguments(PTermIn,F,TermIn), 582 unnumbervars4(TermIn,VsIn,NewVs,TermOut), 583 compound_name_arguments(PTermOut,F,TermOut), 584 PTermOutO=PTermOut. 585 586 587oc_sub_term(X, X). 588oc_sub_term(X, Term) :- 589 compound(Term), 590 arg(_, Term, Arg), 591 oc_sub_term(X, Arg). 592 593 594maybe_fix_varnumbering(MTP,_NewMTP):- term_attvars(MTP,Vs),Vs\==[],!,fail. 595maybe_fix_varnumbering(MTP,NewMTP):- ground(MTP), oc_sub_term(E,MTP),compound(E), E = '$VAR'(N),atomic(N),!, format(string(S),' ~q .',[(MTP)]), 596 notrace(catch( atom_to_term(S,(NewMTP),Vs),E,((ignore(source_location(F,L)),writeq(S->E=F:L),fail)))), \+ ground(NewMTP), 597 (prolog_load_context(variable_names,SVs);SVs=[]),!, 598 align_variables(Vs,SVs,ExtraVs), 599 append(SVs,ExtraVs,NewVs), 600 put_variable_names(NewVs). 601 602fix_varnumbering(MTP,NewMTP):- notrace(maybe_fix_varnumbering(MTP,NewMTP)),!. 603fix_varnumbering(MTP,NewMTP):- MTP=NewMTP. 604 605 606align_variables([],_,[]):- !. 607align_variables([N=V|Vs],SVs,ExtraVs):- 608 member([SN=SV],SVs),N==SN,V=SV,!, 609 align_variables(Vs,SVs,ExtraVs). 610align_variables([NV|Vs],SVs,[NV|ExtraVs]):- 611 align_variables(Vs,SVs,ExtraVs). 612 613 614 615/* 616 617unnumbervars_and_save(X,YO):- 618 term_variables(X,TV), 619 mustvv((source_variables_l(Vs), 620 with_output_to(string(A),write_term(X,[numbervars(true),variable_names(Vs),character_escapes(true),ignore_ops(true),quoted(true)])))), 621 mustvv(atom_to_term(A,Y,NewVs)), 622 (NewVs==[]-> YO=X ; (length(TV,TVL),length(NewVs,NewVarsL),(NewVarsL==TVL-> (YO=X) ; (dtrace,add_newvars(NewVs),Y=X)))). 623 624 625:- export(unnumbervars_and_save/2). 626unnumbervars_and_save(X,YY):- 627 lbl_vars(_,_,X,[],Y,Vs), 628 (Vs==[]->mustvv(X=YY); 629 ( % writeq((lbl_vars(N,NN,X,Y,Vs))),nl, 630 save_clause_vars(Y,Vs),mustvv(Y=YY))). 631 632% todo this slows the system! 633unnumbervars0(X,clause(UH,UB,Ref)):- sanity(nonvar(X)), 634 X = clause(H,B,Ref),!, 635 mustvv(unnumbervars0((H:-B),(UH:-UB))),!. 636 637unnumbervars0(X,YY):-lbl_vars(N,NN,X,YY,_Vs). 638 639lbl_vars(N,NN,X,YY):- 640 must_det_l((with_output_to(string(A),write_term(X,[snumbervars(true),character_escapes(true),ignore_ops(true),quoted(true)])), 641 atom_to_term(A,Y,_NewVars),!,mustvv(YY=Y))),check_varnames(YY). 642lbl_vars(N,NN,X,YY,Vs):-!,lbl_vars(N,NN,X,[],YY,Vs). 643 644lbl_vars(S1,S1,A,OVs,A,OVs):- atomic(A),!. 645lbl_vars(S1,S1,Var,IVs,Var,OVs):- attvar(Var),get_attr(Var,logicmoo_varnames,Nm), (memberchk(Nm=PreV,IVs)->(OVs=IVs,mustvv(PreV==Var));OVs=[Nm=Var|IVs]). 646lbl_vars(S1,S2,Var,IVs,Var,OVs):- var(Var),!,(\+number(S1)->true;(((member(Nm=PreV,IVs),Var==PreV)->(OVs=IVs,put_attr(Var,logicmoo_varnames,Nm)); 647 (format(atom(Nm),'~q',['$VAR'(S1)]),S2 is S1+1,(memberchk(Nm=Var,IVs)->OVs=IVs;OVs=[Nm=Var|IVs]))))). 648 649lbl_vars(S1,S1,NC,OVs,NC,OVs):- ( \+ compound(NC)),!. 650lbl_vars(S1,S1,'$VAR'(Nm),IVs,PreV,OVs):- atom(Nm), !, must(memberchk(Nm=PreV,IVs)->OVs=IVs;OVs=[Nm=PreV|IVs]). 651lbl_vars(S1,S1,'$VAR'(N0),IVs,PreV,OVs):- (number(N0)->format(atom(Nm),'~q',['$VAR'(N0)]);Nm=N0), (memberchk(Nm=PreV,IVs)->OVs=IVs;OVs=[Nm=PreV|IVs]). 652lbl_vars(S1,S3,[X|XM],IVs,[Y|YM],OVs):-!,lbl_vars(S1,S2,X,IVs,Y,VsM),lbl_vars(S2,S3,XM,VsM,YM,OVs). 653lbl_vars(S1,S2,XXM,VsM,YYM,OVs):- XXM=..[F|XM],lbl_vars(S1,S2,XM,VsM,YM,OVs),!,YYM=..[F|YM]. 654 655*/ 656 657/* 658lbl_vars(N,NN,X,YY,Vs):- 659 must_det_l(( 660 with_output_to(codes(A),write_term(X,[numbervars(true),character_escapes(true),ignore_ops(true),quoted(true)])), 661 read_term_from_codes(A,Y,[variable_names(Vs),character_escapes(true),ignore_ops(true)]),!,mustvv(YY=Y),check_varnames(YY))). 662 663 664 665 666unnumbervars_and_copy(X,YO):- 667 term_variables(X,TV), 668 mustvv((source_variables(Vs), 669 with_output_to(string(A),write_term(X,[numbervars(true),variable_names(Vs),character_escapes(true),ignore_ops(true),quoted(true)])))), 670 mustvv(atom_to_term(A,Y,NewVs)), 671 (NewVs==[]-> YO=X ; (length(TV,TVL),length(NewVs,NewVarsL),(NewVarsL==TVL-> (YO=X) ; (dtrace,add_newvars(NewVs),Y=X)))). 672*/ 673 674unnumbervars2a(X,Y):- 675 with_output_to(string(A),write_term(X,[numbervars(true),% variable_names([]), 676 character_escapes(true), 677 ignore_ops(true),quoted(true)])), 678 atom_to_term(A,Y,_NewVs). 679 680 681%add_newvars(_):-!. 682 683%=
689add_newvars(Vs):- (var(Vs);Vs=[]),!. 690add_newvars([N=V|Vs]):- add_newvar(N,V), (var(V)->put_attr(V,vn,N);true), !,add_newvars(Vs). 691 692 693 694%=
700add_newvar(_,V):-nonvar(V),!. 701add_newvar(N,_):-var(N),!. 702add_newvar('A',_):-!. 703add_newvar('B',_):-!. 704add_newvar(N,_):- atom(N),atom_concat('_',_,N),!. 705add_newvar(N,V):- 706 (get_varname_list(V0s)->true;V0s=[]), 707 remove_grounds(V0s,Vs), 708 once((member(NN=Was,Vs),N==NN,var(Was),var(V),(Was=V))-> (V0s==Vs->true;set_varname_list(Vs)); set_varname_list([N=V|Vs])). 709 710 711%=
717remove_grounds(Vs,Vs):-var(Vs),!. 718remove_grounds([],[]):-!. 719remove_grounds([N=V|NewCNamedVarsS],NewCNamedVarsSG):- 720 (N==V;ground(V)),remove_grounds(NewCNamedVarsS,NewCNamedVarsSG). 721remove_grounds([N=V|V0s],[N=NV|Vs]):- 722 (var(V) -> NV=V ; NV=_ ), 723 remove_grounds(V0s,Vs). 724 725% renumbervars_prev(X,X):-ground(X),!. 726 727%=
733renumbervars_prev(X,Y):-renumbervars1(X,[],Y,_),!. 734renumbervars_prev(X,Z):-unnumbervars(X,Y),safe_numbervars(Y,Z),!. 735renumbervars_prev(Y,Z):-safe_numbervars(Y,Z),!. 736 737 738 739%=
745renumbervars1(X,Y):-renumbervars1(X,[],Y,_). 746 747 748%=
754renumbervars1(V,IVs,'$VAR'(X),Vs):- var(V), sformat(atom(X),'~w_RNV',[V]), !, (memberchk(X=V,IVs)->Vs=IVs;Vs=[X=V|IVs]). 755renumbervars1(X,Vs,X,Vs):- ( \+ compound(X)),!. 756renumbervars1('$VAR'(V),IVs,Y,Vs):- sformat(atom(X),'~w_',[V]), !, (memberchk(X=Y,IVs)->Vs=IVs;Vs=[X=Y|IVs]). 757%renumbervars1('$VAR'(V),IVs,Y,Vs):- sformat(atom(X),'~w_VAR',[V]), !, (memberchk(X=Y,IVs)->Vs=IVs;Vs=[X=Y|IVs]). 758renumbervars1([X|XM],IVs,[Y|YM],Vs):-!, 759 renumbervars1(X,IVs,Y,VsM), 760 renumbervars1(XM,VsM,YM,Vs). 761renumbervars1(XXM,IVs,YYM,Vs):- 762 univ_safe_2(XXM,[F,X|XM]), 763 renumbervars1(X,IVs,Y,VsM), 764 renumbervars1(XM,VsM,YM,Vs), 765 univ_safe_2(YYM,[F,Y|YM]). 766 767 768 769 770% ======================================================================================== 771% safe_numbervars/1 (just simpler safe_numbervars.. will use a random start point so if a partially numbered getPrologVars wont get dup getPrologVars) 772% Each prolog has a specific way it could unnumber the result of a safe_numbervars 773% ======================================================================================== 774% 7676767 775 776%=
782safe_numbervars(E,EE):-duplicate_term(E,EE), 783 get_gtime(G),numbervars(EE,G,End,[attvar(skip),functor_name('$VAR'),singletons(true)]), 784 term_variables(EE,AttVars), 785 numbervars(EE,End,_,[attvar(skip),functor_name('$VAR'),singletons(true)]), 786 forall(member(V,AttVars),(copy_term(V,VC,Gs),V='$VAR'(VC=Gs))),check_varnames(EE). 787 788 789%=
795get_gtime(GG):- get_time(T),convert_time(T,_A,_B,_C,_D,_E,_F,G),GG is (floor(G) rem 500). 796 797 798%=
804safe_numbervars(EE):-get_gtime(G),numbervars(EE,G,_End,[attvar(skip),functor_name('$VAR'),singletons(true)]),check_varnames(EE). 805 806 807 808 809% register_var(?, ?, ?) 810% 811% During copying one has to remeber copies of variables which can be used further during copying. 812% Therefore the register of variable copies is maintained. 813% 814 815%=
821register_var(N=V,IN,OUT):- (var(N)->true;register_var(N,IN,V,OUT)),!. 822 823 824%=
830register_var(N,T,V,OUTO):-register_var_0(N,T,V,OUT),mustvv(OUT=OUTO),!. 831register_var(N,T,V,O):-append(T,[N=V],O),!. 832 833 834%=
840register_var_0(N,T,V,OUT):- atom(N),is_list(T),member(NI=VI,T),atom(NI),N=NI,V=@=VI,samify(V,VI),!,OUT=T. 841register_var_0(N,T,V,OUT):- atom(N),is_list(T),member(NI=VI,T),atom(NI),N=NI,V=VI,!,OUT=T. 842 843register_var_0(N,T,V,OUT):- mustvv(nonvar(N)), 844 ((name_to_var(N,T,VOther)-> mustvv((OUT=T,samify(V,VOther))); 845 ((get_varname_list(Before)->true;Before=[]), 846 (name_to_var(N,Before,VOther) -> mustvv((samify(V,VOther),OUT= [N=V|T])); 847 (var_to_name(V,T,_OtherName) -> OUT= [N=V|T]; 848 (var_to_name(V,Before,_OtherName) -> OUT= [N=V|T];fail)))))),!. 849 850 851register_var_0(N,T,V,OUT):- var(N), 852 (var_to_name(V,T,N) -> OUT=T; 853 ((get_varname_list(Before)->true;Before=[]), 854 (var_to_name(V,Before,N) -> OUT= [N=V|T]; 855 OUT= [N=V|T]))),!. 856 857 858 859 860 861% different variables (now merged) 862 863%=
869samify(V,V0):-var(V),var(V0),!,mustvv(V=V0). 870samify(V,V0):-mustvv(V=@=V0),V=V0. 871 872 873%=
879var_to_name(V,[N=V0|T],N):- 880 V==V0 -> true ; % same variables 881 var_to_name(V,T,N). 882 883 884%=
890name_to_var(N,T,V):- var(N),!,var_to_name(N,T,V). 891name_to_var(N,[N0=V0|T],V):- 892 N0==N -> samify(V,V0) ; name_to_var(N,T,V). 893 894 895/* 896% =================================================================== 897% Safely number vars 898% =================================================================== 899bugger_numbervars_with_names(Term):- 900 term_variables(Term,Vars),bugger_name_variables(Vars),!,snumbervars(Vars,91,_,[attvar(skip),singletons(true)]),!, 901 902bugger_name_variables([]). 903bugger_name_variables([Var|Vars]):- 904 (var_property(Var, name(Name)) -> Var = '$VAR'(Name) ; true), 905 bugger_name_variables(Vars). 906 907*/ 908:- export(snumbervars/1). 909 910%=
916snumbervars(Term):-snumbervars(Term,0,_). 917 918:- export(snumbervars/3). 919 920%=
926snumbervars(Term,Start,End):- integer(Start),var(End),!,snumbervars(Term,Start,End,[]). 927snumbervars(Term,Start,List):- integer(Start),is_list(List),!,snumbervars(Term,Start,_,List). 928snumbervars(Term,Functor,Start):- integer(Start),atom(Functor),!,snumbervars(Term,Start,_End,[functor_name(Functor)]). 929snumbervars(Term,Functor,List):- is_list(List),atom(Functor),!,snumbervars(Term,0,_End,[functor_name(Functor)]). 930 931 932:- export(snumbervars/4). 933 934%=
940snumbervars(Term,Start,End,List):-numbervars(Term,Start,End,List). 941 942 943 944 945 946 947 948 949%=
955module_predicate(ModuleName,P,F,A):-current_predicate(ModuleName:F/A),functor_catch(P,F,A), not((( predicate_property(ModuleName:P,imported_from(IM)),IM\==ModuleName ))). 956 957 958:- export((user_ensure_loaded/1)). 959:- module_transparent user_ensure_loaded/1. 960 961%=
967user_ensure_loaded(What):- !, '@'(ensure_loaded(What),'user'). 968 969:- module_transparent user_use_module/1. 970% user_ensure_loaded(logicmoo(What)):- !, '@'(ensure_loaded(logicmoo(What)),'user'). 971% user_use_module(library(What)):- !, use_module(library(What)). 972 973%=
979user_use_module(What):- '@'(use_module(What),'user'). 980 981 982 983 984 985%=
991export_all_preds:-source_location(File,_Line),module_property(M,file(File)),!,export_all_preds(M). 992 993 994%=
1000export_all_preds(ModuleName):-forall(current_predicate(ModuleName:F/A), 1001 ((export(F/A),functor_safe(P,F,A),mpred_trace_nochilds(ModuleName:P)))). 1002 1003 1004 1005 1006 1007 1008 1009%=
1015module_predicate(ModuleName,F,A):-current_predicate(ModuleName:F/A),functor_safe(P,F,A), 1016 \+ ((( predicate_property(ModuleName:P,imported_from(IM)),IM\==ModuleName ))). 1017 1018:- module_transparent(module_predicates_are_exported/0). 1019:- module_transparent(module_predicates_are_exported/1). 1020:- module_transparent(module_predicates_are_exported0/1). 1021 1022 1023%=
1029module_predicates_are_exported:- source_context_module(CM),module_predicates_are_exported(CM). 1030 1031 1032%=
1038module_predicates_are_exported(user):-!,source_context_module(CM),module_predicates_are_exported0(CM). 1039module_predicates_are_exported(Ctx):- module_predicates_are_exported0(Ctx). 1040 1041 1042%=
1048module_predicates_are_exported0(user):- !. % dmsg(warn(module_predicates_are_exported(user))). 1049module_predicates_are_exported0(ModuleName):- 1050 module_property(ModuleName, exports(List)), 1051 findall(F/A, 1052 (module_predicate(ModuleName,F,A), 1053 not(member(F/A,List))), Private), 1054 module_predicates_are_not_exported_list(ModuleName,Private). 1055 1056:- export(export_if_noconflict_mfa/2). 1057:- export(export_if_noconflict_mfa/3). 1058:- module_transparent(export_if_noconflict_mfa/2). 1059:- module_transparent(export_if_noconflict_mfa/3). 1060 1061%=
:- redefine_system_predicate(system:export_if_noconflict/2),abolish(system:export_if_noconflict/2).
1068:- module_transparent(export_if_noconflict/2). 1069:- export(export_if_noconflict/2). 1070export_if_noconflict(M,FA):- export_if_noconflict_mfa(M,FA). 1071:- system:import(export_if_noconflict/2). 1072 1073:- module_transparent(export_if_noconflict_mfa/2). 1074export_if_noconflict_mfa(SM,Var):- var(Var),throw(var(export_if_noconflict_mfa(SM,Var))). 1075export_if_noconflict_mfa(_, M:FA):-!,export_if_noconflict_mfa(M,FA). 1076export_if_noconflict_mfa(SM,(A,B)):-!,export_if_noconflict_mfa(SM,A),export_if_noconflict_mfa(SM,B). 1077export_if_noconflict_mfa(SM,[A]):- !,export_if_noconflict_mfa(SM,A). 1078export_if_noconflict_mfa(SM,[A|B]):-!,export_if_noconflict_mfa(SM,A),export_if_noconflict_mfa(SM,B). 1079export_if_noconflict_mfa(SM,F/A):- !,export_if_noconflict_mfa(SM,F,A). 1080export_if_noconflict_mfa(SM,F//A):- A2 is A + 2, !,export_if_noconflict_mfa(SM,F,A2). 1081export_if_noconflict_mfa(_,SM:F//A):- A2 is A + 2, !,export_if_noconflict_mfa(SM,F,A2). 1082export_if_noconflict_mfa(SM,P):-functor(P,F,A),export_if_noconflict_mfa(SM,F,A). 1083 1084:- module_transparent(export_if_noconflict_mfa/3). 1085export_if_noconflict_mfa(M,F,A):- functor(P,F,A), 1086 predicate_property(M:P,imported_from(Other)), 1087 (Other==system->swi_system_utilities:unlock_predicate(Other:P);true), 1088 Other:export(Other:F/A), 1089 (Other==system->swi_system_utilities:lock_predicate(Other:P);true), 1090 M:import(Other:F/A),!, 1091 M:export(Other:F/A), writeln(rexporting(M=Other:F/A)). 1092export_if_noconflict_mfa(M,F,A):- 1093 functor(P,F,A), 1094 findall(import(Real:F/A), 1095 (current_module(M2),module_property(M2,exports(X)),member(F/A,X), 1096 (predicate_property(M2:P,imported_from(Real))->true;Real=M2), 1097 Real\=M, 1098 writeln(should_be_skipping_export(M:Real=M2:F/A)), 1099 Real:export(Real:F/A), 1100 Real\==M),List), 1101 (List==[]->(M:export(M:F/A)); 1102 (maplist(call,List)),(M:export(M:F/A))). 1103/* 1104export_if_noconflict_mfa(M,F,A):- current_module(M2),M2\=M,module_property(M2,exports(X)), 1105 member(F/A,X),ddmsg(skipping_export(M2=M:F/A)),!, 1106 must(M:export(M:F/A)), 1107 ((M2==system;M==baseKB)->true;must(M2:import(M:F/A))). 1108export_if_noconflict_mfa(M,F,A):-M:export(F/A). 1109*/ 1110% module_predicates_are_not_exported_list(ModuleName,Private):- once((length(Private,Len),dmsg(module_predicates_are_not_exported_list(ModuleName,Len)))),fail. 1111 1112%=
1118module_predicates_are_not_exported_list(ModuleName,Private):- forall(member(F/A,Private),export_if_noconflict(ModuleName,F/A)). 1119 1120 1121 1122 1123 1124 1125%=
1131arg_is_transparent(Arg):- member(Arg,[':','^']). 1132arg_is_transparent(0). 1133arg_is_transparent(Arg):- number(Arg). 1134 1135% make meta_predicate's module_transparent 1136 1137%=
1143module_meta_predicates_are_transparent(_):-!. 1144module_meta_predicates_are_transparent(ModuleName):- 1145 forall((module_predicate(ModuleName,F,A),functor_safe(P,F,A)), 1146 ignore(((predicate_property(ModuleName:P,(meta_predicate( P ))), 1147 not(predicate_property(ModuleName:P,(transparent))), (compound(P),arg(_,P,Arg),arg_is_transparent(Arg))), 1148 (nop(dmsg(todo(module_transparent(ModuleName:F/A)))), 1149 (module_transparent(ModuleName:F/A)))))). 1150 1151:- export(all_module_predicates_are_transparent/1). 1152% all_module_predicates_are_transparent(_):-!. 1153 1154%=
1160all_module_predicates_are_transparent(ModuleName):- 1161 forall((module_predicate(ModuleName,F,A),functor_safe(P,F,A)), 1162 ignore(( 1163 not(predicate_property(ModuleName:P,(transparent))), 1164 ( nop(dmsg(todo(module_transparent(ModuleName:F/A))))), 1165 (module_transparent(ModuleName:F/A))))). 1166 1167 1168%=
1174quiet_all_module_predicates_are_transparent(_):-!. 1175quiet_all_module_predicates_are_transparent(ModuleName):- 1176 forall((module_predicate(ModuleName,F,A),functor_safe(P,F,A)), 1177 ignore(( 1178 not(predicate_property(ModuleName:P,(transparent))), 1179 nop(dmsg(todo(module_transparent(ModuleName:F/A)))), 1180 (module_transparent(ModuleName:F/A))))). 1181 1182 1183%:- multifile(user:term_expansion/2). 1184%:- dynamic(user:term_expansion/2). 1185%:- module_transparent(user:term_expansion/2). 1186% user:term_expansion( (:-export(FA) ),(:- export_if_noconflict(M,FA))):- current_prolog_flag(subclause_expansion,true),prolog_load_context(module,M). 1187 1188 1189:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)), 1190 forall(source_file(M:H,S), 1191 ignore((functor(H,F,A), 1192 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))), 1193 ignore(((\+ predicate_property(M:H,transparent), module_transparent(M:F/A), \+ atom_concat('__aux',_,F),debug(modules,'~N:- module_transparent((~q)/~q).~n',[F,A]))))))))).