1/* Logicmoo Path Setups
2
3 $Id$
4
5 Logicmoo Util Library Path Setups
6
7 File: 'logicmoo_util_terms.pl'
8 Purpose: To load the logicmoo libraries as needed
9 Contact: $Author: dmiles $@users.sourceforge.net ;
10 Version: 'logicmoo_util_terms.pl' 1.0.0
11 Revision: $Revision: 1.7 $
12 Revised At: $Date: 2002/07/11 21:57:28 $
13 Author: Douglas R. Miles
14 Maintainers: logicmoo
15 E-mail: logicmoo@gmail.com
16 WWW: http://www.logicmoo.org
17 SCM: https://github.com/logicmoo/PrologMUD/tree/master/pack/logicmoo_base
18 Copyleft: 1999-2015, LogicMOO Prolog Extensions
19
20 This program is free software; you can redistribute it and/or
21 modify it under the terms of the GNU General Public License
22 as published by the Free Software Foundation; either version 2
23 of the License, or (at your option) any later version.
24
25 This program is distributed in the hope that it will be useful,
26 but WITHOUT ANY WARRANTY; without even the implied warranty of
27 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 GNU General Public License for more details.
29
30 You should have received a copy of the GNU General Public
31 License along with this library; if not, write to the Free Software
32 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
33
34 As a special exception, if you link this library with other files,
35 compiled with a Free Software compiler, to produce an executable, this
36 library does not by itself cause the resulting executable to be covered
37 by the GNU General Public License. This exception does not however
38 invalidate any other reasons why the executable file might be covered by
39 the GNU General Public License.
40*/
46:- module(logicmoo_util_terms, 47 [ 48append_term/3, 49append_term0/3, 50at_start/1, 51remember_at_start/2, 52expire_tabled_list/1, 53call_n_times/2, 54call_no_cuts/1, 55conjoin/3, 56conjoin_op/4, 57conjuncts_to_list/2, 58delete_eq/3, 59disjuncts_to_list/2, 60doall/1, 61dynamic_load_pl/1, 62each_subterm/2, 63each_subterm/3, 64flatten_dedupe/2, 65flatten_set/2, 66wom_functor/3, 67functor_h/2, 68functor_h/3, 69get_functor/2, 70get_functor/3, 71identical_memberchk/2, 72in_thread_and_join/1, 73in_thread_and_join/2, 74is_proof/1, 75is_true/1, 76is_src_true/1, 77lastMember2/2, 78pred_subst/3, 79list_retain/3, 80list_to_conjuncts/2, 81list_to_conjuncts/3, 82list_to_set_safe/2, 83load_assert/3, 84load_dirrective/2, 85load_term/2, 86load_term2/2, 87logicmoo_library_file_loaded/0, 88make_list/3, 89%makeArgIndexes/1, 90%makeArgIndexes/2, 91maptree/3, 92nd_predsubst/3, 93nd_predsubst1/4, 94nd_predsubst2/3, 95nd_subst/4, 96nd_subst1/5, 97nd_subst2/4, 98pred_delete/4, 99pred_juncts_to_list2/3, 100pred_juncts_to_list/3, 101pred_subst/5, 102pred_term_parts/3, 103pred_term_parts_l/3, 104predsubst/3, 105proccess_status/3, 106read_each_term/3, 107remove_dupes/2, 108remove_dupes/3, 109subst/4, 110term_parts/2, 111term_parts_l/2, 112throw_if_true_else_fail/2, 113univ_safe/2, 114univ_term/2, 115weak_nd_subst/4, 116weak_nd_subst1/5, 117weak_nd_subst2/4, 118wsubst/4, 119append_termlist/3, 120append_term0/3, 121apply_term/3, 122atom_concat_safe/3, 123compound_name_args_safe/3, 124compound_name_arity_safe/3 125 ]). 126 127:- set_module(class(library)). 128:- autoload(library(memfile),[memory_file_to_atom/2,atom_to_memory_file/2,open_memory_file/3,open_memory_file/4,free_memory_file/1]). 129 130:-op(700,xfx,('univ_safe')). 131:- system:use_module(library(logicmoo_startup)). 132 133 134:- meta_predicate 135 at_start( ), 136 call_n_times( , ), 137 call_no_cuts( ), 138 doall( ), 139 each_subterm( , , ), 140 functor_h( , ), 141 functor_h( , , ), 142 get_functor( , ), 143 get_functor( , , ), 144 in_thread_and_join( ), 145 in_thread_and_join( , ), 146 list_retain( , , ), 147 load_dirrective( , ), 148 maptree( , , ), 149 nd_predsubst( , , ), 150 nd_predsubst1( , , , ), 151 nd_predsubst2( , , ), 152 pred_delete( , , , ), 153 pred_subst( , , , , ), 154 pred_term_parts( , , ), 155 pred_term_parts_l( , , ), 156 predsubst( , , ), 157 throw_if_true_else_fail( , ). 158:- module_transparent 159 conjoin/3, 160 conjoin_op/4, 161 conjuncts_to_list/2, 162 delete_eq/3, 163 disjuncts_to_list/2, 164 dynamic_load_pl/1, 165 each_subterm/2, 166 flatten_dedupe/2, 167 flatten_set/2, 168 is_proof/1, 169 is_src_true/1, 170 is_true/1, 171 lastMember2/2, 172 list_to_conjuncts/2, 173 list_to_conjuncts/3, 174 list_to_set_safe/2, 175 load_assert/3, 176 load_term/2, 177 load_term2/2, 178 logicmoo_library_file_loaded/0, 179 makeArgIndexes/1, 180 makeArgIndexes/2, 181 make_list/3, 182 nd_subst/4, 183 nd_subst1/5, 184 nd_subst2/4, 185 pred1_juncts_to_list/2, 186 pred1_juncts_to_list/3, 187 proccess_status/3, 188 read_each_term/3, 189 remove_dupes/2, 190 remove_dupes/3, 191 subst/4, 192 term_parts/2, 193 term_parts_l/2, 194 univ_safe/2, 195 univ_term/2, 196 weak_nd_subst/4, 197 weak_nd_subst1/5, 198 weak_nd_subst2/4, 199 wsubst/4. 200 201 202 203 %upcase_atom_safe/2, 204 %get_module_of/2, 205 % concat_atom_safe/3, 206 207 %exists_file_safe/1, 208 %exists_directory_safe/1, 209 %eraseall/2, 210 %time_file_safe/2, 211 212 213% this is a backwards compatablity block for SWI-Prolog 6.6.6 214:- set_module(class(library)). 215% % % OFF :- system:use_module(library(apply)). 216:- dynamic(double_quotes_was_lib/1). 217:- multifile(double_quotes_was_lib/1). 218:- current_prolog_flag(double_quotes,WAS),asserta(double_quotes_was_lib(WAS)). 219:- retract(double_quotes_was_lib(WAS)),set_prolog_flag(double_quotes,WAS). 220:- current_prolog_flag(double_quotes,WAS),asserta(double_quotes_was_lib(WAS)). 221:- set_prolog_flag(double_quotes,string). 222 223 224expire_tabled_list(_). 225 226%=
232lastMember2(_E,List):-var(List),!,fail. 233lastMember2(E,[H|List]):-lastMember2(E,List);E=H. 234 235 236%= 237 238is_true(B):- is_src_true(B).
244:- module_transparent is_src_true/1. 245is_src_true(B):-var(B),!,fail. 246is_src_true(true):-!. 247is_src_true({B}):- !, is_src_true(B). 248is_src_true(props(_,NIL)):- NIL==[]. 249is_src_true(B):-is_proof(B). 250 251 252%=
258is_proof(P):-compound(P),functor(P,ftProofFn,_). 259 260 261:- export(structureless/1). 262structureless(A) :- \+ compound(A),!. 263structureless(A) :- compound_name_arity(A,_,0),!. 264% structureless('$VAR'(_)). 265 266 267sub_compound(_,LF):- \+ compound(LF),!,fail. 268sub_compound(X,X). 269sub_compound(X, Term) :- 270 (is_list(Term) -> 271 (member(E,Term), sub_compound(X,E)) ; 272 (arg(_, Term, Arg), sub_compound(X, Arg))). 273 274 275 276% What would be a good way to describe the manipulations? 277% Function: maptree func expr many 278% Try applying Lisp function func to various sub-expressions of expr. 279% Initially, call func with expr itself as an argument. 280% If this returns an expression which is not equal to expr, apply func again 281% until eventually it does return expr with no changes. Then, if expr is a function call, 282% recursively apply func to each of the arguments. This keeps going until no 283% changes occur anywhere in the expression; this final expression is returned by maptree. 284% Note that, unlike simplification rules, func functions may not make destructive changes to expr. 285% If a third argument many is provided, it is an integer which says how many times func may be applied; 286% the default, as described above, is infinitely many times. 287% = :- meta_predicate(maptree(2,+,-)). 288:- export(maptree/3). 289 290%=
296maptree(Pred,I,O):- call(Pred,I,O),!. 297maptree(_ ,I,O):- structureless(I),!, must(I=O). 298maptree(Pred,[F|IL],LIST):- is_list([F|IL]), (maplist(maptree(Pred),[F|IL],LIST)),!. 299maptree(Pred,I,O):- I=..[F|IL], 300 (maplist(maptree(Pred),[F|IL],[FO|OL])), 301 (atom(FO)-> O=..[FO|OL] ; must((nop(maptree(Pred,I,O)),O=..[F,FO|OL]))). 302 303:- export(disjuncts_to_list/2). 304 305%=
311disjuncts_to_list(Var,[Var]):-is_ftVar(Var),!. 312disjuncts_to_list(true,[]). 313disjuncts_to_list([],[]). 314disjuncts_to_list('v'(A,B),ABL):-!, 315 disjuncts_to_list(A,AL), 316 disjuncts_to_list(B,BL), 317 append(AL,BL,ABL). 318disjuncts_to_list([A|B],ABL):-!, 319 disjuncts_to_list(A,AL), 320 disjuncts_to_list(B,BL), 321 append(AL,BL,ABL). 322disjuncts_to_list((A;B),ABL):-!, 323 disjuncts_to_list(A,AL), 324 disjuncts_to_list(B,BL), 325 append(AL,BL,ABL). 326disjuncts_to_list(Lit,[Lit]). 327 328:- export(conjuncts_to_list/2). 329 330%=
336conjuncts_to_list(Var,[Var]):-is_ftVar(Var),!. 337conjuncts_to_list(true,[]):-!. 338conjuncts_to_list([],[]):-!. 339conjuncts_to_list('&'(A,B),ABL):-!, 340 conjuncts_to_list(A,AL), 341 conjuncts_to_list(B,BL), 342 append(AL,BL,ABL). 343conjuncts_to_list([A|B],ABL):-!, 344 conjuncts_to_list(A,AL), 345 conjuncts_to_list(B,BL), 346 append(AL,BL,ABL). 347conjuncts_to_list((A,B),ABL):-!, 348 conjuncts_to_list(A,AL), 349 conjuncts_to_list(B,BL), 350 append(AL,BL,ABL). 351conjuncts_to_list(Lit,[Lit]). 352 353 354 355pred_juncts_to_list(F,AB,ABL):- pred1_juncts_to_list(==(F),AB,ABL),!. 356 357:- export(pred1_juncts_to_list/3). 358 359%=
365pred1_juncts_to_list(_,Var,[Var]):-is_ftVar(Var),!. 366pred1_juncts_to_list(_,true,[]). 367pred1_juncts_to_list(_,[],[]). 368pred1_juncts_to_list(Pred1,AB,ABL):-AB=..[F,A,B], 369 call(Pred1,F),!, 370 pred1_juncts_to_list(Pred1,A,AL), 371 pred1_juncts_to_list(Pred1,B,BL), 372 append(AL,BL,ABL). 373pred1_juncts_to_list(Pred1,AB,AL):-AB=..[F,A], 374 call(Pred1,F),!, 375 pred1_juncts_to_list(Pred1,A,AL). 376 377pred1_juncts_to_list(Pred1,AB,ABL):-AB=..[F,A|ABB], 378 call(Pred1,F), 379 pred1_juncts_to_list(Pred1,A,AL), 380 B=..[F|ABB], 381 pred1_juncts_to_list(Pred1,B,BL), 382 append(AL,BL,ABL),!. 383pred1_juncts_to_list(_Pred1,Lit,[Lit]). 384 385%=
391pred_juncts_to_list2(_Pred1,I,I):- (is_ftVar(I);I==[]),!. 392pred_juncts_to_list2(Pred1,[A|B],ABL):-!, 393 pred_juncts_to_list2(Pred1,A,AL), 394 pred_juncts_to_list2(Pred1,B,BL), 395 append(AL,BL,ABL). 396pred_juncts_to_list2(_Pred1,Lit,[Lit]). 397 398 399:- export(list_to_conjuncts/2). 400 401%=
407list_to_conjuncts(I,O):-list_to_conjuncts((','),I,O). 408 409:- export(list_to_conjuncts/3). 410 411%=
417list_to_conjuncts(_,V,V):- var(V),!. 418list_to_conjuncts(_,[],true):-!. 419list_to_conjuncts(_,V,V):-not(compound(V)),!. 420list_to_conjuncts(OP,[H],HH):-list_to_conjuncts(OP,H,HH),!. 421 422list_to_conjuncts(OP,[H|T],Body):- current_op(_,yfx,OP),!, 423 list_to_conjuncts_yfx(OP,H,T,Body). 424 425list_to_conjuncts(OP,[H|T],Body):-!, 426 list_to_conjuncts(OP,H,HH), 427 list_to_conjuncts(OP,T,TT), 428 conjoin_op(OP,HH,TT,Body),!. 429list_to_conjuncts(_,H,H). 430 431 432list_to_conjuncts_yfx(_,H,[],H):-!. 433list_to_conjuncts_yfx(OP,Ac,[H|T],Body):- !, 434 conjoin_op(OP,Ac,H,MBody), 435 list_to_conjuncts_yfx(OP,MBody,T,Body). 436list_to_conjuncts_yfx(OP,Ac,T,Body):- 437 conjoin_op(OP,Ac,T,Body). 438 439 440 441 442%=
448conjoin(A,B,C):-A==B,!,C=A. 449conjoin(True,C,C):-True==true,!. 450conjoin(C,True,C):-True==true,!. 451conjoin(A,B,(A,B)):- (var(A);var(B)),!. 452conjoin((A1,A),B,(A1,C)):-!,conjoin(A,B,C). 453conjoin(A1,(A,B),(A1,C)):-!,conjoin(A,B,C). 454conjoin(A,B,(A,B)). 455 456%= conjoin_op(OP,+Conjunct1,+Conjunct2,?Conjunction). 457%= arg4 is a simplified expression representing the conjunction of 458%= args 2 and 3. 459 460 461%=
467conjoin_op(_,TRUE,X,X) :- TRUE==true, !. 468conjoin_op(_,X,X,TRUE) :- TRUE==true, !. 469conjoin_op(_,X,Y,Z) :- X==Y,Z=X,!. 470conjoin_op(OP,C1,C2,C):- current_op(_,yfx,OP),functor(OP,C2,2),C =..[OP,C2,C1],!. 471conjoin_op(OP,C1,C2,C):- C =..[OP,C1,C2]. 472 473% ================================================================================= 474% Utils 475% ================================================================================= 476 477 478 479%=
485read_each_term(S,CMD,Vs):- atom_string(W,S),atom_to_memory_file(W,MF), 486 call_cleanup((open_memory_file(MF,read,Stream,[free_on_close(true)]), 487 findall(CMD-Vs,( 488 repeat, 489 catch((clpfd:read_term(Stream,CMD,[double_quotes(string),variable_names(Vs)])),_,CMD=end_of_file), 490 (CMD==end_of_file->!;true)),Results)), 491 free_memory_file(MF)),!, 492 ((member(CMD-Vs,Results),CMD\==end_of_file)*->true;catch((clpfd:read_term_from_atom(W,CMD,[double_quotes(string),variable_names(Vs)])),_,fail)). 493 494 495 496 497:- export(each_subterm/2). 498 499%=
505each_subterm(B, A):- (compound(B), arg(_, B, C), each_subterm(C, A));A=B. 506 507:- export(each_subterm/3). 508 509%=
515each_subterm(A,Pred,B):- call( Pred,A,B). 516each_subterm(A,Pred,O):- 517 compound(A), 518 once( A=[H|T] ; A=..[H|T] ), 519 (each_subterm(H,Pred,O); 520 each_subterm(T,Pred,O)). 521 522 523 524:- dynamic(argNumsTracked/3). 525%:- dynamic(argNFound/3). 526% :-was_indexed(argNFound(1,1,1)). 527 528 529/* 530%= 531 532%% makeArgIndexes( ?CateSig) is semidet. 533% 534% Make Argument Indexes. 535% 536makeArgIndexes(CateSig):-functor_catch(CateSig,F,_),makeArgIndexes(CateSig,F),!. 537 538%= 539 540%% makeArgIndexes( ?CateSig, ?F) is semidet. 541% 542% Make Argument Indexes. 543% 544makeArgIndexes(CateSig,F):- 545 ignore((argNumsTracked(F,Atom,Number),arg(Number,CateSig,Arg), nonvar(Arg), 546 % Number<10, nonvar(Arg),atom_number(Atom,Number), 547 ( \+ argNFound(F,Atom,Arg),assert(argNFound(F,Atom,Arg))))). 548 549 550*/ 551 552%=
558flatten_dedupe(Percepts0,Percepts):- 559 flatten([Percepts0],Percepts1),remove_dupes(Percepts1,Percepts). 560 561% :- ensure_loaded(logicmoo_util_bugger). 562 563 564%=
570proccess_status(_,exited(called(Det,Goal)),called(Goal2)):- Det = true,!,must_det(Goal=Goal2). 571proccess_status(ID,exited(called(Det,Goal)),called(Goal2)):- dmsg(nondet_proccess_status(ID,exited(called(Det,Goal)),called(Goal2))),!,must_det(Goal=Goal2). 572proccess_status(ID,true,Want):- dmsg(proccess_status(ID,true,Want)),!. 573proccess_status(ID,false,Want):- dmsg(failed_proccess_status(ID,false,Want)),!,fail. 574proccess_status(ID,exception(Status),Want):- dmsg(exception(Status, ID,false,Want)),!,throw(Status). 575proccess_status(ID,exited(Other),Want):-dmsg(wierd_proccess_status(ID,exited(Other),Want)),!. 576 577:- meta_predicate in_thread_and_join( ). 578 579%=
585in_thread_and_join(Goal):-thread_create((Goal,deterministic(Det),thread_exit(called(Det,Goal))),ID,[detatched(false)]),thread_join(ID,Status),show_call(why,proccess_status(ID,Status,called(Goal))). 586:- meta_predicate in_thread_and_join( , ). 587 588%=
594in_thread_and_join(Goal,Status):-thread_create(Goal,ID,[]),thread_join(ID,Status). 595 596 597% =================================================================== 598% Substitution based on Pred 599% =================================================================== 600 601% Usage: predsubst(+Fml,+Pred,?FmlSk) 602 603 604%=
610predsubst(A,Pred, D):- 611 catchv(quietly(nd_predsubst(A,Pred,D)),_,fail),!. 612predsubst(A,_B,A). 613 614 615%=
621nd_predsubst( Var, Pred,SUB ) :- call(Pred,Var,SUB). 622nd_predsubst( Var, _,Var ) :- var(Var),!. 623nd_predsubst( P, Pred, P1 ) :- functor_catch(P,_,N),nd_predsubst1( Pred, P, N, P1 ). 624 625 626%=
632nd_predsubst1( _, P, 0, P ). 633nd_predsubst1( Pred, P, N, P1 ) :- N > 0, compound_name_arguments(P,F,Args), 634 nd_predsubst2( Pred, Args, ArgS ), 635 nd_predsubst2( Pred, [F], [FS] ), 636 univ_term(P1 , [FS|ArgS]). 637 638 639 640%=
646nd_predsubst2( _, [], [] ). 647nd_predsubst2( Pred, [A|As], [Sk|AS] ) :- call(Pred,A,Sk), !, nd_predsubst2( Pred, As, AS). 648nd_predsubst2( Pred, [A|As], [A|AS] ) :- var(A), !, nd_predsubst2( Pred, As, AS). 649nd_predsubst2( Pred, [A|As], [Ap|AS] ) :- nd_predsubst( A,Pred,Ap ),nd_predsubst2( Pred, As, AS). 650nd_predsubst2( _, L, L ). 651 652compound_name_arity_safe(P,F,A):- compound(P) -> compound_name_arity(P,F,A) ; functor(P,F,A). 653 654 655compound_name_args_safe(P,F,A):- 656 ( compound(P) 657 -> (compound(F) ->apply_term(F,A,P);compound_name_arguments(P,F,A)) 658 ; ( atom(F) 659 -> (call(call, ( =.. ),P,[F|A])) 660 ; (apply_term(F,A,P)))),!.
666append_term(M:I,P,M:O):- !, append_term0(I,P,O). 667append_term(I,P,O):- append_term0(I,P,O). 668append_term0(F,I,HEAD):-atom(F),!,HEAD=..[F,I],!. 669append_term0(F,I,HEAD):-atom(F),!,HEAD=..[F,I],!. 670append_term0(Call,E,CallE):-var(Call),!, must(compound(CallE)),CallE=..ListE,append(List,[E],ListE),Call=..List. 671append_term0(Call,E,CallE):-must(compound(Call)), Call=..List, append(List,[E],ListE), CallE=..ListE. 672 673 674apply_term(T,LST,HEAD):- atom(T),!,HEAD=..[T|LST],!. 675apply_term(T,LST,HEAD):- HEAD=..[t,T|LST],!. 676apply_term(T,LST,HEAD):- HEAD==T,!,LST=[]. 677apply_term(T,LST,HEAD):- (LST==[] -> HEAD= T ; (HEAD= T -> LST=[] )).
684append_termlist(M:Call,EList,Out):- nonvar(M),!,append_termlist(Call,EList,CallE),M:CallE=Out. 685append_termlist(Call,EList,CallE):- var(Call),must(is_list(EList)),!,must((append([t,Call],EList,ListE), CallE=..ListE)). 686append_termlist(Call,EList,CallE):-must(is_list(EList)),!,must((Call=..LeftSide, append(LeftSide,EList,ListE), CallE=..ListE)). 687 688 689/* 690compound_name_args_safe(P,F,A):- var(P), 691 compound_name_arguments(P,F,A),!. 692compound_name_args_safe(P,F,A):- atom(F),call(call,=..,P,[F|A]),!. 693compound_name_args_safe(B,P,ARGS):- ARGS==[],!,B=P. 694compound_name_args_safe(B,P,ARGS):- nonvar(ARGS), \+ is_list(ARGS),!,B=[P|ARGS]. 695*/ 696 697% =================================================================== 698% Substitution based on +PRED 699% =================================================================== 700/* 701% Usage: subst(+Pred,+Fml,+X,+Sk,?FmlSk) 702 703pred_subst(Pred,A,B,C,D):- catchv(quietly(nd_pred_subst(Pred,A,B,C,D)),E,(dumpST,dmsg(E:nd_pred_subst(Pred,A,B,C,D)),fail)),!. 704pred_subst(_,A,_B,_C,A). 705 706nd_pred_subst(Pred, Var, VarS,SUB,SUB ) :- call(Pred, Var,VarS),!. 707nd_pred_subst(_Pred, Var, _,_,Var ) :- var(Var),!. 708 709nd_pred_subst(Pred, P, X,Sk, P1 ) :- compound_name_arity_safe(P,_,N),nd_pred_subst1(Pred, X, Sk, P, N, P1 ). 710 711nd_pred_subst1(_Pred, _, _, P, 0, P ). 712nd_pred_subst1(Pred, X, Sk, P, N, P1 ) :- N > 0, univ_term(P , [F|Args]), 713 nd_pred_subst2(Pred, X, Sk, Args, ArgS ), 714 nd_pred_subst2(Pred, X, Sk, [F], [FS] ), 715 univ_term(P1 , [FS|ArgS]). 716 717nd_pred_subst2(_, _, _, [], [] ). 718nd_pred_subst2(Pred, X, Sk, [A|As], [Sk|AS] ) :- call(Pred, X , A), !, nd_pred_subst2(Pred, X, Sk, As, AS). 719nd_pred_subst2(Pred, X, Sk, [A|As], [A|AS] ) :- var(A), !, nd_pred_subst2(Pred, X, Sk, As, AS). 720nd_pred_subst2(Pred, X, Sk, [A|As], [Ap|AS] ) :- nd_pred_subst(Pred, A,X,Sk,Ap ),nd_pred_subst2(Pred, X, Sk, As, AS). 721nd_pred_subst2(_, _X, _Sk, L, L ). 722 723*/ 724 725% -- CODEBLOCK 726% Usage: pred_subst(+Pred,+Fml,+X,+Sk,?FmlSk) 727:- export(pred_subst/5). 728 729 730%=
736pred_subst( Pred, P, X,Sk, P1 ) :- call(Pred,P,X),!,must( Sk=P1),!. 737pred_subst(_Pred, P, _,_ , P1 ) :- is_ftVar(P),!, must(P1=P),!. 738pred_subst( Pred,[P|Args], X,Sk, [P1|ArgS]) :- !, pred_subst(Pred,P,X,Sk,P1),!, must(pred_subst( Pred, Args,X, Sk, ArgS )),!. 739pred_subst( Pred, P, X,Sk, P1 ) :- compound(P),!, compound_name_arguments(P,F,Args), pred_subst( Pred, [F|Args],X, Sk, [Fs|ArgS] ),!, compound_name_arguments(P1,Fs,ArgS),!. 740pred_subst(_Pred ,P, _, _, P ). 741 742:- meta_predicate(pred_subst( , , )). 743pred_subst( Pred, P, X ) :- call(Pred,P,X),!. 744pred_subst(_Pred, P, P1 ) :- is_ftVar(P),!, must(P1=P),!. 745pred_subst( Pred,[P|Args], [P1|ArgS]) :- !, pred_subst(Pred,P,P1),!, must(pred_subst( Pred, Args, ArgS )),!. 746pred_subst( Pred, P, P1 ) :- compound(P),!, compound_name_arguments(P,F,Args), pred_subst( Pred, [F|Args], [Fs|ArgS] ),!, compound_name_arguments(P1,Fs,ArgS),!. 747pred_subst(_Pred ,P, P ). 748 749 750% dcgPredicate(M,F,A,P). 751 752 753%=
760'univ_safe'(P,[L|IST]):- compound(P) -> compound_name_arguments(P,L,IST) ; P=..[L|IST]. 761%univ_safe(P,[L|L1]):- nonvar(P), must((var(L);atom(L))),!,on_x_debug(( P=..[L|L1] )). 762%univ_safe(P,L):- must_det(is_list(L)),on_x_debug((P=..L)). 763 764:- op(700,xfx,prolog:('univ_safe')). 765 766safe_functor(P,F,A):- compound(P) -> compound_name_arity(P,F,A) ; functor(P,F,A). 767:- export(safe_functor/3). 768 769m_functor(M:P, M:F, A):- !, safe_functor(P, F, A). 770m_functor(P, F, A):- safe_functor(P, F, A). 771 772wom_functor(MP, F, A):- strip_module(MP,_,P),safe_functor(P, F, A). 773 774% =================================================================== 775% Substitution based on == 776% =================================================================== 777 778% Usage: subst(+Fml,+X,+Sk,?FmlSk) 779 780% :- mpred_trace_nochilds(subst/4). 781 782 783%=
subst(A,B,C,D)
:- quietly((catchv(quietly(nd_subst(A,B,C,D)),E,(dumpST,dmsg(E:nd_subst(A,B,C,D)),fail))))
,!.
790subst(A,B,C,D):- (must(nd_subst(A,B,C,D0))),on_x_debug(D=D0),!. 791subst(A,_B,_C,A). 792 793:- export(subst/4). 794 795subst_each(A,[NV|List],D):- 796 (NV=..[_,N,V]->true;NV=..[N,V]),!, 797 subst(A,N,V,M), 798 subst_each(M,List,D). 799subst_each(A,_,A). 800 801:- export(subst_each/3). 802 803%=
809nd_subst( Var, VarS,SUB,SUB ) :- Var==VarS,!. 810% nd_subst( Var, _,_,Var ) :- var(Var),!. 811nd_subst( Var, _,_,Var ) :- \+ compound(Var),!. 812nd_subst( P, X,Sk, P1 ) :- 813 compound_name_arity(P,_,N), 814 nd_subst1( X, Sk, P, N, P1 ),!. 815 816 817%=
823nd_subst1( _, _, P, 0, P ). 824nd_subst1( X, Sk, P, N, P1 ) :- N > 0, univ_term(P , [F|Args]), 825 nd_subst2( X, Sk, Args, ArgS ), 826 nd_subst2( X, Sk, [F], [FS] ), 827 univ_term(P1 , [FS|ArgS]). 828 829 830%=
836nd_subst2( _, _, [], [] ). 837nd_subst2( X, Sk, [A|As], [Sk|AS] ) :- X == A, !, nd_subst2( X, Sk, As, AS). 838nd_subst2( X, Sk, [A|As], [A|AS] ) :- var(A), !, nd_subst2( X, Sk, As, AS). 839nd_subst2( X, Sk, [A|As], [Ap|AS] ) :- nd_subst( A,X,Sk,Ap ),!,nd_subst2( X, Sk, As, AS). 840nd_subst2( _X, _Sk, L, L ). 841 842 843%=
849univ_term(P1,[FS|ArgS]):- compound(FS),!,append_termlist(FS,ArgS,P1). 850univ_term(P1,[FS|ArgS]):- univ_safe(P1 , [FS|ArgS]). 851 852 853 854%=
860wsubst(A,B,C,D):- 861 catchv(quietly(weak_nd_subst(A,B,C,D)),_,fail),!. 862wsubst(A,_B,_C,A). 863 864 865%=
871weak_nd_subst( Var, VarS,SUB,SUB ) :- nonvar(Var),Var=VarS,!. 872weak_nd_subst( P, X,Sk, P1 ) :- functor_catch(P,_,N),weak_nd_subst1( X, Sk, P, N, P1 ). 873 874 875%=
881weak_nd_subst1( _, _, P, 0, P ). 882 883weak_nd_subst1( X, Sk, P, N, P1 ) :- N > 0, 884 compound_name_arguments(P,F,Args), 885 weak_nd_subst2( X, Sk, Args, ArgS ), 886 weak_nd_subst2( X, Sk, [F], [FS] ), 887 univ_term(P1 , [FS|ArgS]). 888 889 890%=
896weak_nd_subst2( _, _, [], [] ). 897weak_nd_subst2( X, Sk, [A|As], [Sk|AS] ) :- nonvar(A), X = A, !, weak_nd_subst2( X, Sk, As, AS). 898weak_nd_subst2( X, Sk, [A|As], [A|AS] ) :- var(A), !, weak_nd_subst2( X, Sk, As, AS). 899weak_nd_subst2( X, Sk, [A|As], [Ap|AS] ) :- weak_nd_subst( A,X,Sk,Ap ),weak_nd_subst2( X, Sk, As, AS). 900weak_nd_subst2( _X, _Sk, L, L ). 901 902 903 904%=
910make_list(E,1,[E]):-!. 911make_list(E,N,[E|List]):- M1 is N - 1, make_list(E,M1,List),!. 912 913:- export(flatten_set/2). 914 915%=
921flatten_set(L,S):-flatten([L],F),list_to_set(F,S),!. 922%flatten_set(Percepts0,Percepts):- flatten([Percepts0],Percepts1),remove_dupes(Percepts1,Percepts). 923 924 925%=
931remove_dupes(In,Out):-remove_dupes(In,Out,[]). 932 933 934%=
940remove_dupes([],[],_):-!. 941remove_dupes([I|In],Out,Shown):-member(I,Shown),!,remove_dupes(In,Out,Shown). 942remove_dupes([I|In],[I|Out],Shown):-remove_dupes(In,Out,[I|Shown]). 943 944% = :- meta_predicate(functor_h(?,?)). 945 946%=
952functor_h(Obj,F):- functor_h(Obj,F,_). 953 954%=
960get_functor(Obj,FO):- must(functor_h(Obj,F,_)),!,FO=F. 961 962%=
968get_functor(Obj,FO,AO):- must(functor_h(Obj,F,A)),!,FO=F,AO=A. 969 970% = :- meta_predicate(functor_h(?,?,?)). 971 972%=
978functor_h(Obj,F,A):- var(Obj),!,trace_or_throw(var_functor_h(Obj,F,A)). 979functor_h('$VAR'(Obj),F,A):- !, trace_or_throw(var_functor_h('$VAR'(Obj),F,A)). 980% functor_h(Obj,F,A):- var(Obj),!,(number(A)->functor(Obj,F,A);((current_predicate(F/A);throw(var_functor_h(Obj,F,A))))). 981 982functor_h(M:Obj,MF,A):-(callable(Obj);atom(M)),!,functor_h(Obj,F,A),(MF=F;MF=M:F). 983functor_h(F//A, 984 F,Ap2):-number(A),!,Ap2 is A+2,( atom(F) -> true ; current_predicate(F/Ap2)). 985functor_h(F/A,F,A):-number(A),!,( atom(F) -> true ; current_predicate(F/A)). 986functor_h(Obj,F,A):-atom(F),strip_module(Obj,_M,P),functor(P,F,A). 987 988functor_h([L|Ist],F,A):- is_list([L|Ist]),!,var(F),L=F,length(Ist,A). 989functor_h(':-'(Obj,_),F,A):- nonvar(Obj), !,functor_h(Obj,F,A). 990functor_h(M:_,F,A):- atom(M),!, ( M=F -> current_predicate(F/A) ; current_predicate(M:F/A)). 991functor_h(':-'(Obj),F,A):- nonvar(Obj), !,functor_h(Obj,F,A). 992 993functor_h(Obj,F,0):- string(Obj),!,maybe_notrace(atom_string(F,Obj)). 994 995functor_h(Obj,Obj,0):- \+ compound(Obj),!. 996functor_h(Obj,F,0):- compound_name_arity(Obj,F,0),!. 997functor_h(Obj,F,A):-var(F),!,strip_module(Obj,_M,P),functor(P,F,A). 998functor_h(Obj,F,A):-functor(Obj,F,A). 999 1000 1001 1002:- meta_predicate call_n_times( , ). 1003 1004%=
1010call_n_times(0,_Goal):-!. 1011call_n_times(1,Goal):-!,. 1012call_n_times(N,Goal):-doall((between(2,N,_),once(Goal))),. 1013 1014 1015:- meta_predicate at_start( ). 1016:- meta_predicate remember_at_start( , ). 1017 1018:- volatile(lmcache:at_started/1). 1019:- volatile(lmcache:needs_started/2). 1020:- dynamic(lmcache:at_started/1). 1021:- dynamic(lmcache:needs_started/2). 1022 1023%=
1029at_start(Goal):- 1030 copy_term(Goal,Named), 1031 numbervars(Named,0,_,[attvar(bind),singletons(true)]), 1032 initialization(remember_at_start(Named,Goal)), 1033 initialization(remember_at_start(Named,Goal),restore). 1034 1035remember_at_start(Named,_):- lmcache:at_started(Named),!. 1036remember_at_start(Named,Goal):- compiling,!,call(assert,lmcache:needs_started(Named,Goal)). 1037remember_at_start(Named,Goal):- 1038 catchv( 1039 (call(assert,lmcache:at_started(Named)),on_f_debug((Goal))), 1040 E, 1041 (retractall(lmcache:at_started(Named)),call(assert,lmcache:needs_started(Named,Goal)),trace_or_throw(E))). 1042 1043run_at_start:- forall(lmcache:needs_started(Named,Goal),remember_at_start(Named,Goal)). 1044 1045 1046:- initialization(run_at_start). 1047:- initialization(run_at_start,restore). 1048 1049:- export(list_to_set_safe/2). 1050 1051%=
1057list_to_set_safe(A,A):-(var(A);atomic(A)),!. 1058list_to_set_safe([A|AA],BB):- ( \+ ( \+ (lastMember2(A,AA))) -> list_to_set_safe(AA,BB) ; (list_to_set_safe(AA,NB),BB=[A|NB])),!. 1059 1060 1061 1062 1063 1064%=
1070term_parts(A,[A]):- not(compound(A)),!. 1071term_parts([A|L],TERMS):-!,term_parts_l([A|L],TERMS). 1072term_parts(Comp,[P/A|TERMS]):- functor_catch(Comp,P,A), Comp=..[P|List],term_parts_l(List,TERMS). 1073 1074 1075%=
1081term_parts_l(Var,[open(Var),Var]):-var(Var),!. 1082term_parts_l([],[]):-!. 1083term_parts_l([A|L],TERMS):-!,term_parts(A,AP),term_parts_l(L,LP),append(AP,LP,TERMS). 1084term_parts_l(Term,[open(Term)|TERMS]):-term_parts(Term,TERMS),!. 1085 1086 1087%=
1093pred_term_parts(Pred,A,[A]):- call(Pred,A),!. 1094pred_term_parts(_Pred,A,[]):-not(compound(A)),!. 1095pred_term_parts(Pred,[A|L],TERMS):-!,pred_term_parts_l(Pred,[A|L],TERMS),!. 1096pred_term_parts(Pred,Comp,TERMS):-Comp=..[P,A|List],pred_term_parts_l(Pred,[P,A|List],TERMS),!. 1097pred_term_parts(_,_Term,[]). 1098 1099 1100%=
1106pred_term_parts_l(_,NV,[]):-NV==[],!. 1107pred_term_parts_l(Pred,[A|L],TERMS):-!,pred_term_parts(Pred,A,AP),pred_term_parts_l(Pred,L,LP),append(AP,LP,TERMS),!. 1108pred_term_parts_l(Pred,Term,TERMS):-pred_term_parts(Pred,Term,TERMS),!. 1109pred_term_parts_l(_,_Term,[]). 1110 1111 1112%=
1118throw_if_true_else_fail(T,E):- once(quietly(T)),trace_or_throw(throw_if_true_else_fail(E:T)). 1119 1120 1121%=
1127list_retain(PL,Pred,Result):- throw_if_true_else_fail(not(is_list(PL)),list_retain(PL,Pred,Result)). 1128list_retain([],_Pred,[]):-!. 1129list_retain([R|List],Pred,[R|Retained]):- call(Pred,R),!, list_retain(List,Pred,Retained). 1130list_retain([_|List],Pred,Retained):- list_retain(List,Pred,Retained). 1131 1132:- export(identical_memberchk/2). 1133 1134%=
1140identical_memberchk(_,Var):-var(Var),!,fail. 1141identical_memberchk(X,[Y|_]) :- 1142 X == Y, 1143 !. 1144identical_memberchk(X,[_|L]) :- 1145 identical_memberchk(X,L). 1146 1147:- export(delete_eq/3). 1148:- export(pred_delete/4). 1149 1150%=
1156delete_eq(A,B,C):-pred_delete(==,A,B,C). 1157 1158%=
1164pred_delete(_,[], _, []). 1165pred_delete(Pred,[A|C], B, D) :- 1166 ( call(Pred,A,B) 1167 -> pred_delete(Pred,C, B, D) 1168 ; D=[A|E], 1169 pred_delete(Pred,C, B, E) 1170 ). 1171 1172 1173 1174:- export(doall/1). 1175:- meta_predicate doall( ). 1176 1177%=
1183doall(M:C):-!, M:ignore(M:(C,fail)). 1184doall(C):-ignore((C,fail)). 1185 1186% ================================================================================= 1187% Loader Utils 1188% ================================================================================= 1189 1190 1191 1192%=
1198dynamic_load_pl(PLNAME):-ensure_loaded(PLNAME),!. 1199 1200dynamic_load_pl(PLNAME):- % unload_file(PLNAME), 1201 open(PLNAME, read, In, []), 1202 repeat, 1203 line_count(In,Lineno), 1204 % double_quotes(_DQBool) 1205 Options = [variables(_Vars),variable_names(_VarNames),singletons(_Singletons),comment(_Comment)], 1206 catchv((read_term(In,Term,[syntax_errors(error)|Options])),E,(dmsg(E),fail)), 1207 load_term(Term,[line_count(Lineno),file(PLNAME),stream(In)|Options]), 1208 Term==end_of_file, 1209 close(In). 1210 1211 1212%=
1218load_term(E,_Options):- E == end_of_file, !. 1219load_term(Term,Options):-catchv(load_term2(Term,Options),E,(dmsg(error(load_term(Term,Options,E))),throw_safe(E))). 1220 1221 1222%=
1228load_term2(':-'(Term),Options):-!,load_dirrective(Term,Options),!. 1229load_term2(:-(H,B),Options):-!,load_assert(H,B,Options). 1230load_term2(Fact,Options):-!,load_assert(Fact,true,Options). 1231 1232 1233%=
1239load_assert(H,B,_Options):-assert((:-)),!. 1240 1241 1242%=
1248load_dirrective(include(PLNAME),_Options):- (atom_concat_safe(Key,'.pl',PLNAME) ; Key=PLNAME),!, dynamic_load_pl(Key). 1249load_dirrective(CALL,_Options):- CALL=..[module,M,_Preds],!,module(M),call(CALL). 1250load_dirrective(Term,_Options):-!,.
1256atom_concat_safe(L,R,A):- ((atom(A),(atom(L);atom(R))) ; ((atom(L),atom(R)))), !, atom_concat(L,R,A),!. 1257 1258% ===================================================================================================================== 1259:- export((call_no_cuts/1)). 1260% ===================================================================================================================== 1261:- meta_predicate call_no_cuts( ). 1262:- module_transparent call_no_cuts/1. 1263 1264%=
1270call_no_cuts(ereq(A)):-!,call_no_cuts(A). 1271call_no_cuts(call_u(A)):-!,call_no_cuts(A). 1272call_no_cuts((A,B)):-!,(call_no_cuts(A),call_no_cuts(B)). 1273call_no_cuts((A;B)):-!,(call_no_cuts(A);call_no_cuts(B)). 1274call_no_cuts((A->B)):-!,(call_no_cuts(A)->call_no_cuts(B)). 1275call_no_cuts((A*->B;C)):-!,(call_no_cuts(A)->call_no_cuts(B);call_no_cuts(C)). 1276call_no_cuts((A->B;C)):-!,(call_no_cuts(A)->call_no_cuts(B);call_no_cuts(C)). 1277call_no_cuts(M:CALL):-atom(M),!,functor(CALL,F,A),functor(C,F,A),must(once( \+ ( \+ (clause(M:C,_))))),!,clause(M:,TEST),M:on_x_debug(TEST). 1278call_no_cuts(CALL):-functor(CALL,F,A),functor(C,F,A),must(once( \+ ( \+ (clause(C,_))))),!,clause(CALL,TEST),on_x_debug(TEST). 1279 1280 1281% this is a backwards compatablity block for SWI-Prolog 6.6.6 1282:- current_prolog_flag(double_quotes,WAS),asserta(double_quotes_was_lib(WAS)). 1283 1284%:- module_predicates_are_exported. 1285% :- all_module_predicates_are_transparent(logicmoo_util_terms). 1286 1287 1288%=
1294logicmoo_library_file_loaded. 1295 1296:- fixup_exports.
Common Util MISC_TERMS
This module includes random predicate utilities that manipulate terms for substitution, decomposes, recomposes, composes, etc. @author Douglas R. Miles @license free or GNU 2 */