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            lc_tcall/1
   18          ]).   19
   20:- module_transparent((is_loop_checked/1,
   21            lco_goal_expansion/2,            
   22            cyclic_break/1,
   23
   24            loop_check_early/2,loop_check_term/3,
   25            loop_check_term/3,no_loop_check_term/3,loop_check_term_frame/5,
   26            
   27            loop_check/1,loop_check/2,no_loop_check/1,no_loop_check/2,
   28            current_loop_checker/1,
   29            push_loop_checker/0,
   30            pop_loop_checker/0,
   31            transitive/3,
   32            transitive_except/4,
   33            transitive_lc/3,
   34            lc_tcall/1)).   35
   36:- set_module(class(library)).  
   37:- use_module(library(apply)).   38
   39
   40%:- use_module(library(tabling)).
   41:- use_module(library(each_call_cleanup)).   42%:- use_module(library(logicmoo_util_startup)).
   43
   44
   45:- meta_predicate  
   46        lc_tcall(0),
   47
   48        loop_check(0), loop_check(0, 0),
   49        no_loop_check(0), no_loop_check(0, 0),
   50        
   51        loop_check_early(0, 0), loop_check_term(0, ?, 0),
   52
   53        % loop_check_term(0, ?, 0),no_loop_check_term(0, ?, 0),
   54        
   55        transitive(2, +, -),
   56        transitive_except(+, 2, +, -),
   57        transitive_lc(2, +, -).   58        
   59/* memoize_on(+,+,0), memoize_on(+,+,+,0), */
   60
   61
   62:- module_transparent
   63        can_fail/1,
   64        get_where/1,
   65        get_where0/1,
   66        is_loop_checked/1,
   67        lco_goal_expansion/2.
 transitive(:PRED2X, +A, -B) is nondet
Transitive.
   77transitive(X,A,B):- once(on_x_debug(call(X,A,R)) -> ( R\=@=A -> transitive_lc(X,R,B) ; B=R); B=A),!.
 transitive_lc(:PRED2X, +A, -B) is nondet
Transitive Not Loop Checked.
   86transitive_lc(X,A,B):-transitive_except([],X,A,B).
 transitive_except(+NotIn, :PRED2X, +A, -B) is nondet
Transitive Except.
   95transitive_except(NotIn,X,A,B):- memberchk_same_two(A,NotIn)-> (B=A,!) ;
   96  ((once(on_x_debug(call(X,A,R)) -> ( R\=@=A -> transitive_except([A|NotIn],X,R,B) ; B=R); B=A))),!.
 memberchk_same_two(?X, :TermY0) is nondet
Memberchk Same Two.
  105memberchk_same_two(X, [Y0|Ys]) :- is_list(Ys),!,C=..[v,Y0|Ys],!, arg(_,C,Y), ( X =@= Y ->  (var(X) -> X==Y ; true)),!.
  106memberchk_same_two(X, [Y|Ys]) :- (   X =@= Y ->  (var(X) -> X==Y ; true) ;   (nonvar(Ys),memberchk_same_two(X, Ys) )).
 cyclic_break(?Cyclic) is nondet
Cyclic Break.
  113cyclic_break(Cyclic):-cyclic_term(Cyclic)->(writeq(cyclic_break(Cyclic)),nl,prolog);true.
  114
  115
  116% ===================================================================
  117% Loop checking
  118% ===================================================================
  119:- thread_local lmcache:ilc/2.  120:- thread_local lmcache:ilc/3.  121
  122% = :- meta_predicate(lc_tcall(0)).
  123% lc_tcall(C0):-reduce_make_key(C0,C),!,table(C),!,query(C).
  124% lc_tcall(C0):-query(C).
 lc_tcall(:GoalC) is nondet
Call Tabled
  132:- meta_predicate(lc_tcall(0)).  133%:- table(lc_tcall/1).
  134lc_tcall(G):- loop_check(call(G)).
 loop_check_early(:Call, :LoopCaught) is nondet
Loop Check Early.
  142loop_check_early(Call, LoopCaught):- loop_check(Call, LoopCaught).
 loop_check(:Call) is nondet
Loop Check.
  150loop_check(Call):- loop_check(Call, fail).
 loop_check(:Call, :OnLoopCaught) is nondet
Loop Check.
  158loop_check(Call, LoopCaught):- 
  159  loop_check_term(Call,Call,LoopCaught).
 no_loop_check(:Call) is nondet
No Loop Check.
  167no_loop_check(Call):- no_loop_check(Call, fail).
 no_loop_check(:Call, :LoopCaught) is nondet
No Loop Check.
  175no_loop_check(Call, LoopCaught):- no_loop_check_term(Call,Call,LoopCaught).
 no_loop_check_term(:Call, +Key, :LoopCaught) is nondet
Pushes a new Loop checking frame so all previous checks are suspended

no_loop_check_term(Call,_Key,_LoopCaught):-!,Call.

  183no_loop_check_term(Call,Key,LoopCaught):- 
  184   trusted_redo_call_cleanup(push_loop_checker,
  185                     loop_check_term(Call,Key,LoopCaught),
  186                     pop_loop_checker).
  187
  188:- thread_initialization(nb_setval('$loop_checker',1)).  189:- initialization(nb_setval('$loop_checker',1),restore).  190current_loop_checker(LC):- ((nb_current('$loop_checker',LC),number(LC))->true;LC=0).
  191push_loop_checker :- current_loop_checker(LC),LC2 is LC+1,nb_setval('$loop_checker',LC2).
  192pop_loop_checker :- current_loop_checker(LC),LC2 is LC-1,nb_setval('$loop_checker',LC2).
 is_loop_checked(?Call) is nondet
If Is A Loop Checked.
  199is_loop_checked(Key):- 
  200  prolog_current_frame(Frame),
  201  notrace(make_frame_key(Key,Frame,KeyS,GoaL,SearchFrame)),
  202  loop_check_term_frame(fail,KeyS,GoaL,SearchFrame,true).
  203
  204
  205make_frame_key(Key,Frame,Part1,Part2,Parent1):-
  206  prolog_frame_attribute(Frame,parent,Parent1),
  207  make_key(Key,Part1,Part2).
  208
  209:- '$hide'(make_frame_key/5).  210
  211make_key(key(Part1),Part1,Part2):-!,current_loop_checker(Part2).
  212make_key(key(Key,GoaLs),Part1,Part2):-!,current_loop_checker(LC),make_key5(Key,GoaLs,LC,Part1,Part2).
  213make_key(Key,Key,Part2):- ground(Key),!,current_loop_checker(Part2).
  214make_key(Key,Part1,Part2):- copy_term(Key,KeyS,GoaLs),current_loop_checker(LC),make_key5(KeyS,GoaLs,LC,Part1,Part2).
  215
  216make_key5(Part1,[],LC,Part1,LC):-!,numbervars(Part1,242,_,[attvar(error)]).
  217make_key5(Part1,GoaLs,LC,Part1,[LC|GoaLs]):-numbervars(Part1+GoaLs,242,_,[attvar(error)]).
  218
  219
  220     
  221% :- meta_predicate(loop_check_term_frame(+,+,+,+,:)).
  222loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught):- 
  223 % set_prolog_flag(debug,true),
  224 set_prolog_flag(last_call_optimisation,false),
  225 % set_prolog_flag(gc,false),
  226 !,
  227   (prolog_frame_attribute(SearchFrame,parent_goal,
  228      loop_check_term_frame(_,KeyS,GoaL,_,_))
  229    -> (LoopCaught,true)
  230    ;  (loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught),true)),true.
  231
  232loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught):-  !,
  233  ( notrace(parent_frame_goal_0(SearchFrame,
  234      loop_check_term_frame_grovel(_,KeyS,GoaL,_,_)))
  235    -> (LoopCaught,true)
  236    ;  (Call,true)).
  237
  238
  239
  240is_parent_goal(G):- prolog_current_frame(F),is_parent_goal(F,G).
  241% The user must ensure the checked parent goal is not removed from the stack due 
  242% to last-call optimisation 
  243is_parent_goal(F,G):- nonvar(G),prolog_frame_attribute(F,parent_goal, G).
  244%and be aware of the slow operation on deeply nested calls.
  245is_parent_goal(F,G):- prolog_frame_attribute(F,parent,P),parent_frame_goal(P,G).
  246
  247parent_frame_goal(F,V):- parent_frame_goal_0(F,V0),contains_goalf(V0,V).
  248parent_frame_goal_0(F,V):- prolog_frame_attribute(F,goal,V);
  249   (prolog_frame_attribute(F,parent,P),parent_frame_goal_0(P,V)).
  250
  251contains_goalf(V0,V):- nonvar(V),same_goalf(V0,V),!.
  252contains_goalf(V0,_):- \+ compound(V0),!,fail.
  253contains_goalf(V0,V):- var(V),same_goalf(V0,V).
  254contains_goalf(_:V0,V):- !, contains_goalf(V0,V).
  255contains_goalf('$execute_directive_3'(V0),V):-!, same_goalf(V0,V).
  256contains_goalf('<meta-call>'(V0),V):-!, same_goalf(V0,V).
  257contains_goalf(catch(V0,_,_),V):- same_goalf(V0,V).
  258contains_goalf(catch(_,_,V0),V):- same_goalf(V0,V).
  259same_goalf(V,V).
 loop_check_term(:Call, +Key, :LoopCaught) is nondet
Loop Check Term 50% of the time
  267%loop_check_term(Call,_Key,_LoopCaught):- zotrace((current_prolog_flag(unsafe_speedups , true) , 1 is random(2))),!,call(Call).
  268% loop_check_term(Call,_Key,_LoopCaught):-!,Call.
  269
  270loop_check_term(Call,Key,LoopCaught):- 
  271   prolog_current_frame(Frame),
  272   notrace(make_frame_key(Key,Frame,KeyS,GoaL,SearchFrame)),
  273   loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught).
 get_where(:TermB) is nondet
Get Where.
  280get_where(B:L):-get_where0(F:L),file_base_name(F,B).
 get_where0(:GoalF) is nondet
Get Where Primary Helper.
  287get_where0(F:L):-source_location(file,F),current_input(S),line_position(S,L),!.
  288get_where0(F:L):-source_location(F,L),!.
  289get_where0(A:0):-current_input(S),stream_property(S,alias(A)),!.
  290get_where0(M:0):-source_context_module(M),!.
  291get_where0(baseKB:0):-!.
 lco_goal_expansion(:TermB, :TermA) is nondet
Lco Call Expansion.
  301lco_goal_expansion(V,VV):- \+ compound(V),!,V=VV.
  302lco_goal_expansion(loop_check(G),O):-!,lco_goal_expansion(loop_check(G,fail),O).
  303lco_goal_expansion(no_loop_check(G),O):-!,lco_goal_expansion(no_loop_check(G,fail),O).
  304lco_goal_expansion(loop_check(G,LoopCaught),loop_check_term(G,info(G,W),LoopCaught)):- get_where(W).
  305lco_goal_expansion(no_loop_check(G,LoopCaught),no_loop_check_term(G,info(G,W),LoopCaught)):- get_where(W).
  306lco_goal_expansion(B,A):- 
  307  compound_name_arguments(B,F,ARGS),
  308  F \== (meta_predicate),
  309  maplist(lco_goal_expansion,ARGS,AARGS),
  310  compound_name_arguments(A,F,AARGS).
  311lco_goal_expansion(A,A).
  312
  313:- if(current_predicate(fixup_exports/0)).  314:- fixup_exports.  315:- endif.  316
  317:- multifile system:goal_expansion/4.  318:- dynamic system:goal_expansion/4.  319system:goal_expansion(LC,Pos,LCO,Pos):- notrace((compound(LC),lco_goal_expansion(LC,LCO)))->LC\=@=LCO