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([I|TermIn],VsIn,NewVs,[O|TermOut]):- !,unnumbervars4(I,VsIn,VsM,O),unnumbervars4(TermIn,VsM,NewVs,TermOut). 574unnumbervars4(Var,Vs,Vs,Var):- compound_name_arity(Var,_,0), !. 575unnumbervars4((I,TermIn),VsIn,NewVs,(O,TermOut)):- !,unnumbervars4(I,VsIn,VsM,O),unnumbervars4(TermIn,VsM,NewVs,TermOut). 576unnumbervars4((I:TermIn),VsIn,NewVs,(O:TermOut)):- !,unnumbervars4(I,VsIn,VsM,O),unnumbervars4(TermIn,VsM,NewVs,TermOut). 577unnumbervars4('$VAR'(Name),VsIn,NewVs,Var):- nonvar(Name),!, (member(Name=Var,VsIn)->NewVs=VsIn;NewVs=[Name=Var|VsIn]),!, 578 put_attr(Var,vn,Name). 579unnumbervars4(PTermIn,VsIn,NewVs,PTermOutO):- compound(PTermIn),!, compound_name_arguments(PTermIn,F,TermIn), 580 unnumbervars4(TermIn,VsIn,NewVs,TermOut), 581 compound_name_arguments(PTermOut,F,TermOut), 582 PTermOutO=PTermOut. 583 584 585oc_sub_term(X, X). 586oc_sub_term(X, Term) :- 587 compound(Term), 588 arg(_, Term, Arg), 589 oc_sub_term(X, Arg). 590 591 592maybe_fix_varnumbering(MTP,_NewMTP):- term_attvars(MTP,Vs),Vs\==[],!,fail. 593maybe_fix_varnumbering(MTP,NewMTP):- ground(MTP), oc_sub_term(E,MTP),compound(E), E = '$VAR'(N),atomic(N),!, format(string(S),' ~q .',[(MTP)]), 594 notrace(catch( atom_to_term(S,(NewMTP),Vs),E,((ignore(source_location(F,L)),writeq(S->E=F:L),fail)))), \+ ground(NewMTP), 595 (prolog_load_context(variable_names,SVs);SVs=[]),!, 596 align_variables(Vs,SVs,ExtraVs), 597 append(SVs,ExtraVs,NewVs), 598 put_variable_names(NewVs). 599 600fix_varnumbering(MTP,NewMTP):- notrace(maybe_fix_varnumbering(MTP,NewMTP)),!. 601fix_varnumbering(MTP,NewMTP):- MTP=NewMTP. 602 603 604align_variables([],_,[]):- !. 605align_variables([N=V|Vs],SVs,ExtraVs):- 606 member([SN=SV],SVs),N==SN,V=SV,!, 607 align_variables(Vs,SVs,ExtraVs). 608align_variables([NV|Vs],SVs,[NV|ExtraVs]):- 609 align_variables(Vs,SVs,ExtraVs). 610 611 612 613/* 614 615unnumbervars_and_save(X,YO):- 616 term_variables(X,TV), 617 mustvv((source_variables_l(Vs), 618 with_output_to(string(A),write_term(X,[numbervars(true),variable_names(Vs),character_escapes(true),ignore_ops(true),quoted(true)])))), 619 mustvv(atom_to_term(A,Y,NewVs)), 620 (NewVs==[]-> YO=X ; (length(TV,TVL),length(NewVs,NewVarsL),(NewVarsL==TVL-> (YO=X) ; (dtrace,add_newvars(NewVs),Y=X)))). 621 622 623:- export(unnumbervars_and_save/2). 624unnumbervars_and_save(X,YY):- 625 lbl_vars(_,_,X,[],Y,Vs), 626 (Vs==[]->mustvv(X=YY); 627 ( % writeq((lbl_vars(N,NN,X,Y,Vs))),nl, 628 save_clause_vars(Y,Vs),mustvv(Y=YY))). 629 630% todo this slows the system! 631unnumbervars0(X,clause(UH,UB,Ref)):- sanity(nonvar(X)), 632 X = clause(H,B,Ref),!, 633 mustvv(unnumbervars0((H:-B),(UH:-UB))),!. 634 635unnumbervars0(X,YY):-lbl_vars(N,NN,X,YY,_Vs). 636 637lbl_vars(N,NN,X,YY):- 638 must_det_l((with_output_to(string(A),write_term(X,[snumbervars(true),character_escapes(true),ignore_ops(true),quoted(true)])), 639 atom_to_term(A,Y,_NewVars),!,mustvv(YY=Y))),check_varnames(YY). 640lbl_vars(N,NN,X,YY,Vs):-!,lbl_vars(N,NN,X,[],YY,Vs). 641 642lbl_vars(S1,S1,A,OVs,A,OVs):- atomic(A),!. 643lbl_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]). 644lbl_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)); 645 (format(atom(Nm),'~q',['$VAR'(S1)]),S2 is S1+1,(memberchk(Nm=Var,IVs)->OVs=IVs;OVs=[Nm=Var|IVs]))))). 646 647lbl_vars(S1,S1,NC,OVs,NC,OVs):- ( \+ compound(NC)),!. 648lbl_vars(S1,S1,'$VAR'(Nm),IVs,PreV,OVs):- atom(Nm), !, must(memberchk(Nm=PreV,IVs)->OVs=IVs;OVs=[Nm=PreV|IVs]). 649lbl_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]). 650lbl_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). 651lbl_vars(S1,S2,XXM,VsM,YYM,OVs):- XXM=..[F|XM],lbl_vars(S1,S2,XM,VsM,YM,OVs),!,YYM=..[F|YM]. 652 653*/ 654 655/* 656lbl_vars(N,NN,X,YY,Vs):- 657 must_det_l(( 658 with_output_to(codes(A),write_term(X,[numbervars(true),character_escapes(true),ignore_ops(true),quoted(true)])), 659 read_term_from_codes(A,Y,[variable_names(Vs),character_escapes(true),ignore_ops(true)]),!,mustvv(YY=Y),check_varnames(YY))). 660 661 662 663 664unnumbervars_and_copy(X,YO):- 665 term_variables(X,TV), 666 mustvv((source_variables(Vs), 667 with_output_to(string(A),write_term(X,[numbervars(true),variable_names(Vs),character_escapes(true),ignore_ops(true),quoted(true)])))), 668 mustvv(atom_to_term(A,Y,NewVs)), 669 (NewVs==[]-> YO=X ; (length(TV,TVL),length(NewVs,NewVarsL),(NewVarsL==TVL-> (YO=X) ; (dtrace,add_newvars(NewVs),Y=X)))). 670*/ 671 672unnumbervars2a(X,Y):- 673 with_output_to(string(A),write_term(X,[numbervars(true),% variable_names([]), 674 character_escapes(true), 675 ignore_ops(true),quoted(true)])), 676 atom_to_term(A,Y,_NewVs). 677 678 679%add_newvars(_):-!. 680 681%=
687add_newvars(Vs):- (var(Vs);Vs=[]),!. 688add_newvars([N=V|Vs]):- add_newvar(N,V), (var(V)->put_attr(V,vn,N);true), !,add_newvars(Vs). 689 690 691 692%=
698add_newvar(_,V):-nonvar(V),!. 699add_newvar(N,_):-var(N),!. 700add_newvar('A',_):-!. 701add_newvar('B',_):-!. 702add_newvar(N,_):- atom(N),atom_concat('_',_,N),!. 703add_newvar(N,V):- 704 (get_varname_list(V0s)->true;V0s=[]), 705 remove_grounds(V0s,Vs), 706 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])). 707 708 709%=
715remove_grounds(Vs,Vs):-var(Vs),!. 716remove_grounds([],[]):-!. 717remove_grounds([N=V|NewCNamedVarsS],NewCNamedVarsSG):- 718 (N==V;ground(V)),remove_grounds(NewCNamedVarsS,NewCNamedVarsSG). 719remove_grounds([N=V|V0s],[N=NV|Vs]):- 720 (var(V) -> NV=V ; NV=_ ), 721 remove_grounds(V0s,Vs). 722 723% renumbervars_prev(X,X):-ground(X),!. 724 725%=
731renumbervars_prev(X,Y):-renumbervars1(X,[],Y,_),!. 732renumbervars_prev(X,Z):-unnumbervars(X,Y),safe_numbervars(Y,Z),!. 733renumbervars_prev(Y,Z):-safe_numbervars(Y,Z),!. 734 735 736 737%=
743renumbervars1(X,Y):-renumbervars1(X,[],Y,_). 744 745 746%=
752renumbervars1(V,IVs,'$VAR'(X),Vs):- var(V), sformat(atom(X),'~w_RNV',[V]), !, (memberchk(X=V,IVs)->Vs=IVs;Vs=[X=V|IVs]). 753renumbervars1(X,Vs,X,Vs):- ( \+ compound(X)),!. 754renumbervars1('$VAR'(V),IVs,Y,Vs):- sformat(atom(X),'~w_',[V]), !, (memberchk(X=Y,IVs)->Vs=IVs;Vs=[X=Y|IVs]). 755%renumbervars1('$VAR'(V),IVs,Y,Vs):- sformat(atom(X),'~w_VAR',[V]), !, (memberchk(X=Y,IVs)->Vs=IVs;Vs=[X=Y|IVs]). 756renumbervars1([X|XM],IVs,[Y|YM],Vs):-!, 757 renumbervars1(X,IVs,Y,VsM), 758 renumbervars1(XM,VsM,YM,Vs). 759renumbervars1(XXM,IVs,YYM,Vs):- 760 univ_safe_2(XXM,[F,X|XM]), 761 renumbervars1(X,IVs,Y,VsM), 762 renumbervars1(XM,VsM,YM,Vs), 763 univ_safe_2(YYM,[F,Y|YM]). 764 765 766 767 768% ======================================================================================== 769% safe_numbervars/1 (just simpler safe_numbervars.. will use a random start point so if a partially numbered getPrologVars wont get dup getPrologVars) 770% Each prolog has a specific way it could unnumber the result of a safe_numbervars 771% ======================================================================================== 772% 7676767 773 774%=
780safe_numbervars(E,EE):-duplicate_term(E,EE), 781 get_gtime(G),numbervars(EE,G,End,[attvar(skip),functor_name('$VAR'),singletons(true)]), 782 term_variables(EE,AttVars), 783 numbervars(EE,End,_,[attvar(skip),functor_name('$VAR'),singletons(true)]), 784 forall(member(V,AttVars),(copy_term(V,VC,Gs),V='$VAR'(VC=Gs))),check_varnames(EE). 785 786 787%=
793get_gtime(GG):- get_time(T),convert_time(T,_A,_B,_C,_D,_E,_F,G),GG is (floor(G) rem 500). 794 795 796%=
802safe_numbervars(EE):-get_gtime(G),numbervars(EE,G,_End,[attvar(skip),functor_name('$VAR'),singletons(true)]),check_varnames(EE). 803 804 805 806 807% register_var(?, ?, ?) 808% 809% During copying one has to remeber copies of variables which can be used further during copying. 810% Therefore the register of variable copies is maintained. 811% 812 813%=
819register_var(N=V,IN,OUT):- (var(N)->true;register_var(N,IN,V,OUT)),!. 820 821 822%=
828register_var(N,T,V,OUTO):-register_var_0(N,T,V,OUT),mustvv(OUT=OUTO),!. 829register_var(N,T,V,O):-append(T,[N=V],O),!. 830 831 832%=
838register_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. 839register_var_0(N,T,V,OUT):- atom(N),is_list(T),member(NI=VI,T),atom(NI),N=NI,V=VI,!,OUT=T. 840 841register_var_0(N,T,V,OUT):- mustvv(nonvar(N)), 842 ((name_to_var(N,T,VOther)-> mustvv((OUT=T,samify(V,VOther))); 843 ((get_varname_list(Before)->true;Before=[]), 844 (name_to_var(N,Before,VOther) -> mustvv((samify(V,VOther),OUT= [N=V|T])); 845 (var_to_name(V,T,_OtherName) -> OUT= [N=V|T]; 846 (var_to_name(V,Before,_OtherName) -> OUT= [N=V|T];fail)))))),!. 847 848 849register_var_0(N,T,V,OUT):- var(N), 850 (var_to_name(V,T,N) -> OUT=T; 851 ((get_varname_list(Before)->true;Before=[]), 852 (var_to_name(V,Before,N) -> OUT= [N=V|T]; 853 OUT= [N=V|T]))),!. 854 855 856 857 858 859% different variables (now merged) 860 861%=
867samify(V,V0):-var(V),var(V0),!,mustvv(V=V0). 868samify(V,V0):-mustvv(V=@=V0),V=V0. 869 870 871%=
877var_to_name(V,[N=V0|T],N):- 878 V==V0 -> true ; % same variables 879 var_to_name(V,T,N). 880 881 882%=
888name_to_var(N,T,V):- var(N),!,var_to_name(N,T,V). 889name_to_var(N,[N0=V0|T],V):- 890 N0==N -> samify(V,V0) ; name_to_var(N,T,V). 891 892 893/* 894% =================================================================== 895% Safely number vars 896% =================================================================== 897bugger_numbervars_with_names(Term):- 898 term_variables(Term,Vars),bugger_name_variables(Vars),!,snumbervars(Vars,91,_,[attvar(skip),singletons(true)]),!, 899 900bugger_name_variables([]). 901bugger_name_variables([Var|Vars]):- 902 (var_property(Var, name(Name)) -> Var = '$VAR'(Name) ; true), 903 bugger_name_variables(Vars). 904 905*/ 906:- export(snumbervars/1). 907 908%=
914snumbervars(Term):-snumbervars(Term,0,_). 915 916:- export(snumbervars/3). 917 918%=
924snumbervars(Term,Start,End):- integer(Start),var(End),!,snumbervars(Term,Start,End,[]). 925snumbervars(Term,Start,List):- integer(Start),is_list(List),!,snumbervars(Term,Start,_,List). 926snumbervars(Term,Functor,Start):- integer(Start),atom(Functor),!,snumbervars(Term,Start,_End,[functor_name(Functor)]). 927snumbervars(Term,Functor,List):- is_list(List),atom(Functor),!,snumbervars(Term,0,_End,[functor_name(Functor)]). 928 929 930:- export(snumbervars/4). 931 932%=
938snumbervars(Term,Start,End,List):-numbervars(Term,Start,End,List). 939 940 941 942 943 944 945 946 947%=
953module_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 ))). 954 955 956:- export((user_ensure_loaded/1)). 957:- module_transparent user_ensure_loaded/1. 958 959%=
965user_ensure_loaded(What):- !, '@'(ensure_loaded(What),'user'). 966 967:- module_transparent user_use_module/1. 968% user_ensure_loaded(logicmoo(What)):- !, '@'(ensure_loaded(logicmoo(What)),'user'). 969% user_use_module(library(What)):- !, use_module(library(What)). 970 971%=
977user_use_module(What):- '@'(use_module(What),'user'). 978 979 980 981 982 983%=
989export_all_preds:-source_location(File,_Line),module_property(M,file(File)),!,export_all_preds(M). 990 991 992%=
998export_all_preds(ModuleName):-forall(current_predicate(ModuleName:F/A), 999 ((export(F/A),functor_safe(P,F,A),mpred_trace_nochilds(ModuleName:P)))). 1000 1001 1002 1003 1004 1005 1006 1007%=
1013module_predicate(ModuleName,F,A):-current_predicate(ModuleName:F/A),functor_safe(P,F,A), 1014 \+ ((( predicate_property(ModuleName:P,imported_from(IM)),IM\==ModuleName ))). 1015 1016:- module_transparent(module_predicates_are_exported/0). 1017:- module_transparent(module_predicates_are_exported/1). 1018:- module_transparent(module_predicates_are_exported0/1). 1019 1020 1021%=
1027module_predicates_are_exported:- source_context_module(CM),module_predicates_are_exported(CM). 1028 1029 1030%=
1036module_predicates_are_exported(user):-!,source_context_module(CM),module_predicates_are_exported0(CM). 1037module_predicates_are_exported(Ctx):- module_predicates_are_exported0(Ctx). 1038 1039 1040%=
1046module_predicates_are_exported0(user):- !. % dmsg(warn(module_predicates_are_exported(user))). 1047module_predicates_are_exported0(ModuleName):- 1048 module_property(ModuleName, exports(List)), 1049 findall(F/A, 1050 (module_predicate(ModuleName,F,A), 1051 not(member(F/A,List))), Private), 1052 module_predicates_are_not_exported_list(ModuleName,Private). 1053 1054:- export(export_if_noconflict_mfa/2). 1055:- export(export_if_noconflict_mfa/3). 1056:- module_transparent(export_if_noconflict_mfa/2). 1057:- module_transparent(export_if_noconflict_mfa/3). 1058 1059%=
:- redefine_system_predicate(system:export_if_noconflict/2)
,abolish(system:export_if_noconflict/2)
.
1066:- module_transparent(export_if_noconflict/2). 1067:- export(export_if_noconflict/2). 1068export_if_noconflict(M,FA):- export_if_noconflict_mfa(M,FA). 1069:- system:import(export_if_noconflict/2). 1070 1071:- module_transparent(export_if_noconflict_mfa/2). 1072export_if_noconflict_mfa(SM,Var):- var(Var),throw(var(export_if_noconflict_mfa(SM,Var))). 1073export_if_noconflict_mfa(_, M:FA):-!,export_if_noconflict_mfa(M,FA). 1074export_if_noconflict_mfa(SM,(A,B)):-!,export_if_noconflict_mfa(SM,A),export_if_noconflict_mfa(SM,B). 1075export_if_noconflict_mfa(SM,[A]):- !,export_if_noconflict_mfa(SM,A). 1076export_if_noconflict_mfa(SM,[A|B]):-!,export_if_noconflict_mfa(SM,A),export_if_noconflict_mfa(SM,B). 1077export_if_noconflict_mfa(SM,F/A):- !,export_if_noconflict_mfa(SM,F,A). 1078export_if_noconflict_mfa(SM,F//A):- A2 is A + 2, !,export_if_noconflict_mfa(SM,F,A2). 1079export_if_noconflict_mfa(_,SM:F//A):- A2 is A + 2, !,export_if_noconflict_mfa(SM,F,A2). 1080export_if_noconflict_mfa(SM,P):-functor(P,F,A),export_if_noconflict_mfa(SM,F,A). 1081 1082:- module_transparent(export_if_noconflict_mfa/3). 1083export_if_noconflict_mfa(M,F,A):- functor(P,F,A), 1084 predicate_property(M:P,imported_from(Other)), 1085 (Other==system->swi_system_utilities:unlock_predicate(Other:P);true), 1086 Other:export(Other:F/A), 1087 (Other==system->swi_system_utilities:lock_predicate(Other:P);true), 1088 M:import(Other:F/A),!, 1089 M:export(Other:F/A), writeln(rexporting(M=Other:F/A)). 1090export_if_noconflict_mfa(M,F,A):- 1091 functor(P,F,A), 1092 findall(import(Real:F/A), 1093 (current_module(M2),module_property(M2,exports(X)),member(F/A,X), 1094 (predicate_property(M2:P,imported_from(Real))->true;Real=M2), 1095 Real\=M, 1096 writeln(should_be_skipping_export(M:Real=M2:F/A)), 1097 Real:export(Real:F/A), 1098 Real\==M),List), 1099 (List==[]->(M:export(M:F/A)); 1100 (maplist(call,List)),(M:export(M:F/A))). 1101/* 1102export_if_noconflict_mfa(M,F,A):- current_module(M2),M2\=M,module_property(M2,exports(X)), 1103 member(F/A,X),ddmsg(skipping_export(M2=M:F/A)),!, 1104 must(M:export(M:F/A)), 1105 ((M2==system;M==baseKB)->true;must(M2:import(M:F/A))). 1106export_if_noconflict_mfa(M,F,A):-M:export(F/A). 1107*/ 1108% module_predicates_are_not_exported_list(ModuleName,Private):- once((length(Private,Len),dmsg(module_predicates_are_not_exported_list(ModuleName,Len)))),fail. 1109 1110%=
1116module_predicates_are_not_exported_list(ModuleName,Private):- forall(member(F/A,Private),export_if_noconflict(ModuleName,F/A)). 1117 1118 1119 1120 1121 1122 1123%=
1129arg_is_transparent(Arg):- member(Arg,[':','^']). 1130arg_is_transparent(0). 1131arg_is_transparent(Arg):- number(Arg). 1132 1133% make meta_predicate's module_transparent 1134 1135%=
1141module_meta_predicates_are_transparent(_):-!. 1142module_meta_predicates_are_transparent(ModuleName):- 1143 forall((module_predicate(ModuleName,F,A),functor_safe(P,F,A)), 1144 ignore(((predicate_property(ModuleName:P,(meta_predicate( P ))), 1145 not(predicate_property(ModuleName:P,(transparent))), (compound(P),arg(_,P,Arg),arg_is_transparent(Arg))), 1146 (nop(dmsg(todo(module_transparent(ModuleName:F/A)))), 1147 (module_transparent(ModuleName:F/A)))))). 1148 1149:- export(all_module_predicates_are_transparent/1). 1150% all_module_predicates_are_transparent(_):-!. 1151 1152%=
1158all_module_predicates_are_transparent(ModuleName):- 1159 forall((module_predicate(ModuleName,F,A),functor_safe(P,F,A)), 1160 ignore(( 1161 not(predicate_property(ModuleName:P,(transparent))), 1162 ( nop(dmsg(todo(module_transparent(ModuleName:F/A))))), 1163 (module_transparent(ModuleName:F/A))))). 1164 1165 1166%=
1172quiet_all_module_predicates_are_transparent(_):-!. 1173quiet_all_module_predicates_are_transparent(ModuleName):- 1174 forall((module_predicate(ModuleName,F,A),functor_safe(P,F,A)), 1175 ignore(( 1176 not(predicate_property(ModuleName:P,(transparent))), 1177 nop(dmsg(todo(module_transparent(ModuleName:F/A)))), 1178 (module_transparent(ModuleName:F/A))))). 1179 1180 1181%:- multifile(user:term_expansion/2). 1182%:- dynamic(user:term_expansion/2). 1183%:- module_transparent(user:term_expansion/2). 1184% user:term_expansion( (:-export(FA) ),(:- export_if_noconflict(M,FA))):- current_prolog_flag(subclause_expansion,true),prolog_load_context(module,M). 1185 1186 1187:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)), 1188 forall(source_file(M:H,S), 1189 ignore((functor(H,F,A), 1190 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))), 1191 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]))))))))).