1% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_loop_check.pl 2:- module(loop_check, 3 [ is_loop_checked/1, 4 lco_goal_expansion/2, 5 cyclic_break/1, 6 7 loop_check_early/2,loop_check_term/3, 8 loop_check_term/3,no_loop_check_term/3, 9 10 loop_check/1,loop_check/2,no_loop_check/1,no_loop_check/2, 11 current_loop_checker/1, 12 push_loop_checker/0, 13 pop_loop_checker/0, 14 transitive/3, 15 transitive_except/4, 16 transitive_lc/3, 17 is_parent_goal/2, 18 lc_tcall/1 19 ]). 20 21:- module_transparent((is_loop_checked/1, 22 lco_goal_expansion/2, 23 cyclic_break/1, 24 25 loop_check_early/2,loop_check_term/3, 26 loop_check_term/3,no_loop_check_term/3,loop_check_term_frame/5, 27 28 loop_check/1,loop_check/2,no_loop_check/1,no_loop_check/2, 29 current_loop_checker/1, 30 push_loop_checker/0, 31 pop_loop_checker/0, 32 transitive/3, 33 transitive_except/4, 34 transitive_lc/3, 35 lc_tcall/1)). 36 37:- set_module(class(library)). 38:- use_module(library(apply)). 39 40 41%:- use_module(library(tabling)). 42:- use_module(library(each_call_cleanup)). 43%:- use_module(library(logicmoo_util_startup)). 44 45 46:- meta_predicate 47 lc_tcall( ), 48 49 loop_check( ), loop_check( , ), 50 no_loop_check( ), no_loop_check( , ), 51 52 loop_check_early( , ), loop_check_term( , , ), 53 54 % loop_check_term(0, ?, 0),no_loop_check_term(0, ?, 0), 55 56 transitive( , , ), 57 transitive_except( , , , ), 58 transitive_lc( , , ). 59 60/* memoize_on(+,+,0), memoize_on(+,+,+,0), */ 61 62 63:- module_transparent 64 can_fail/1, 65 get_where/1, 66 get_where0/1, 67 is_loop_checked/1, 68 lco_goal_expansion/2.
78transitive(X,A,B):- once(on_x_debug(call(X,A,R)) -> ( R\=@=A -> transitive_lc(X,R,B) ; B=R); B=A),!.
87transitive_lc(X,A,B):-transitive_except([],X,A,B).
96transitive_except(NotIn,X,A,B):- memberchk_same_two(A,NotIn)-> (B=A,!) ;
97 ((once(on_x_debug(call(X,A,R)) -> ( R\=@=A -> transitive_except([A|NotIn],X,R,B) ; B=R); B=A))),!.
106memberchk_same_two(X, [Y0|Ys]) :- is_list(Ys),!,C=..[v,Y0|Ys],!, arg(_,C,Y), ( X =@= Y -> (var(X) -> X==Y ; true)),!. 107memberchk_same_two(X, [Y|Ys]) :- ( X =@= Y -> (var(X) -> X==Y ; true) ; (nonvar(Ys),memberchk_same_two(X, Ys) )).
114cyclic_break(Cyclic):-cyclic_term(Cyclic)->(writeq(cyclic_break(Cyclic)),nl,prolog);true. 115 116 117% =================================================================== 118% Loop checking 119% =================================================================== 120:- thread_local lmcache:ilc/2. 121:- thread_local lmcache:ilc/3. 122 123% = :- meta_predicate(lc_tcall(0)). 124% lc_tcall(C0):-reduce_make_key(C0,C),!,table(C),!,query(C). 125% lc_tcall(C0):-query(C).
133:- meta_predicate(lc_tcall( )). 134%:- table(lc_tcall/1). 135lc_tcall(G):- loop_check(call(G)).
143loop_check_early(Call, LoopCaught):- loop_check(Call, LoopCaught).
151loop_check(Call):- loop_check(Call, fail).
159loop_check(Call, LoopCaught):-
160 loop_check_term(Call,Call,LoopCaught).
168no_loop_check(Call):- no_loop_check(Call, fail).
176no_loop_check(Call, LoopCaught):- no_loop_check_term(Call,Call,LoopCaught).
no_loop_check_term(Call,_Key,_LoopCaught)
:-!,Call.
184no_loop_check_term(Call,Key,LoopCaught):- 185 trusted_redo_call_cleanup(push_loop_checker, 186 loop_check_term(Call,Key,LoopCaught), 187 pop_loop_checker). 188 189:- thread_initialization(nb_setval('$loop_checker',1)). 190:- initialization(nb_setval('$loop_checker',1),restore). 191current_loop_checker(LC):- ((nb_current('$loop_checker',LC),number(LC))->true;LC=0). 192push_loop_checker :- current_loop_checker(LC),LC2 is LC+1,nb_setval('$loop_checker',LC2). 193pop_loop_checker :- current_loop_checker(LC),LC2 is LC-1,nb_setval('$loop_checker',LC2).
200is_loop_checked(Key):- 201 prolog_current_frame(Frame), 202 notrace(make_frame_key(Key,Frame,KeyS,GoaL,SearchFrame)), 203 loop_check_term_frame(fail,KeyS,GoaL,SearchFrame,true). 204 205 206make_frame_key(Key,Frame,Part1,Part2,Parent1):- 207 prolog_frame_attribute(Frame,parent,Parent1), 208 make_key(Key,Part1,Part2). 209 210:- '$hide'(make_frame_key/5). 211 212make_key(key(Part1),Part1,Part2):-!,current_loop_checker(Part2). 213make_key(key(Key,GoaLs),Part1,Part2):-!,current_loop_checker(LC),make_key5(Key,GoaLs,LC,Part1,Part2). 214make_key(Key,Key,Part2):- ground(Key),!,current_loop_checker(Part2). 215make_key(Key,Part1,Part2):- copy_term(Key,KeyS,GoaLs),current_loop_checker(LC),make_key5(KeyS,GoaLs,LC,Part1,Part2). 216 217make_key5(Part1,[],LC,Part1,LC):-!,numbervars(Part1,242,_,[attvar(error)]). 218make_key5(Part1,GoaLs,LC,Part1,[LC|GoaLs]):-numbervars(Part1+GoaLs,242,_,[attvar(error)]). 219 220 221 222% :- meta_predicate(loop_check_term_frame(+,+,+,+,:)). 223loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught):- 224 % set_prolog_flag(debug,true), 225 set_prolog_flag(last_call_optimisation,false), 226 % set_prolog_flag(gc,false), 227 !, 228 (prolog_frame_attribute(SearchFrame,parent_goal, 229 loop_check_term_frame(_,KeyS,GoaL,_,_)) 230 -> (,true) 231 ; (loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught),true)),true. 232 233loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught):- !, 234 ( notrace(parent_frame_goal_0(SearchFrame, 235 loop_check_term_frame_grovel(_,KeyS,GoaL,_,_))) 236 -> (,true) 237 ; (,true)). 238 239 240 241is_parent_goal(G):- prolog_current_frame(F),is_parent_goal(F,G). 242% The user must ensure the checked parent goal is not removed from the stack due 243% to last-call optimisation 244is_parent_goal(F,G):- nonvar(G),prolog_frame_attribute(F,parent_goal, G). 245%and be aware of the slow operation on deeply nested calls. 246is_parent_goal(F,G):- prolog_frame_attribute(F,parent,P),parent_frame_goal(P,G). 247 248parent_frame_goal(F,V):- parent_frame_goal_0(F,V0),contains_goalf(V0,V). 249parent_frame_goal_0(F,V):- prolog_frame_attribute(F,goal,V); 250 (prolog_frame_attribute(F,parent,P),parent_frame_goal_0(P,V)). 251 252contains_goalf(V0,V):- nonvar(V),same_goalf(V0,V),!. 253contains_goalf(V0,_):- \+ compound(V0),!,fail. 254contains_goalf(V0,V):- var(V),same_goalf(V0,V). 255contains_goalf(_:V0,V):- !, contains_goalf(V0,V). 256contains_goalf('$execute_directive_3'(V0),V):-!, same_goalf(V0,V). 257contains_goalf('<meta-call>'(V0),V):-!, same_goalf(V0,V). 258contains_goalf(catch(V0,_,_),V):- same_goalf(V0,V). 259contains_goalf(catch(_,_,V0),V):- same_goalf(V0,V). 260same_goalf(V,V).
268%loop_check_term(Call,_Key,_LoopCaught):- zotrace((current_prolog_flag(unsafe_speedups , true) , 1 is random(2))),!,call(Call). 269% loop_check_term(Call,_Key,_LoopCaught):-!,Call. 270 271loop_check_term(Call,Key,LoopCaught):- 272 prolog_current_frame(Frame), 273 notrace(make_frame_key(Key,Frame,KeyS,GoaL,SearchFrame)), 274 loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught).
281get_where(B:L):-get_where0(F:L),file_base_name(F,B).
288get_where0(F:L):-source_location(file,F),current_input(S),line_position(S,L),!. 289get_where0(F:L):-source_location(F,L),!. 290get_where0(A:0):-current_input(S),stream_property(S,alias(A)),!. 291get_where0(M:0):-source_context_module(M),!. 292get_where0(baseKB:0):-!.
302lco_goal_expansion(V,VV):- \+ compound(V),!,V=VV. 303lco_goal_expansion(loop_check(G),O):-!,lco_goal_expansion(loop_check(G,fail),O). 304lco_goal_expansion(no_loop_check(G),O):-!,lco_goal_expansion(no_loop_check(G,fail),O). 305lco_goal_expansion(loop_check(G,LoopCaught),loop_check_term(G,info(G,W),LoopCaught)):- get_where(W). 306lco_goal_expansion(no_loop_check(G,LoopCaught),no_loop_check_term(G,info(G,W),LoopCaught)):- get_where(W). 307lco_goal_expansion(B,A):- 308 compound_name_arguments(B,F,ARGS), 309 F \== (meta_predicate), 310 maplist(lco_goal_expansion,ARGS,AARGS), 311 compound_name_arguments(A,F,AARGS). 312lco_goal_expansion(A,A). 313 314:- if(current_predicate(fixup_exports/0)). 315:- fixup_exports. 316:- endif. 317 318:- multifile system:goal_expansion/4. 319:- dynamic system:goal_expansion/4. 320systemgoal_expansion(LC,Pos,LCO,Pos):- notrace((compound(LC),lco_goal_expansion(LC,LCO)))->LC\=@=LCO