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(0),
   48
   49        loop_check(0), loop_check(0, 0),
   50        no_loop_check(0), no_loop_check(0, 0),
   51        
   52        loop_check_early(0, 0), loop_check_term(0, ?, 0),
   53
   54        % loop_check_term(0, ?, 0),no_loop_check_term(0, ?, 0),
   55        
   56        transitive(2, +, -),
   57        transitive_except(+, 2, +, -),
   58        transitive_lc(2, +, -).   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.
 transitive(:PRED2X, +A, -B) is nondet
Transitive.
   78transitive(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.
   87transitive_lc(X,A,B):-transitive_except([],X,A,B).
 transitive_except(+NotIn, :PRED2X, +A, -B) is nondet
Transitive Except.
   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))),!.
 memberchk_same_two(?X, :TermY0) is nondet
Memberchk Same Two.
  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) )).
 cyclic_break(?Cyclic) is nondet
Cyclic Break.
  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).
 lc_tcall(:GoalC) is nondet
Call Tabled
  133:- meta_predicate(lc_tcall(0)).  134%:- table(lc_tcall/1).
  135lc_tcall(G):- loop_check(call(G)).
 loop_check_early(:Call, :LoopCaught) is nondet
Loop Check Early.
  143loop_check_early(Call, LoopCaught):- loop_check(Call, LoopCaught).
 loop_check(:Call) is nondet
Loop Check.
  151loop_check(Call):- loop_check(Call, fail).
 loop_check(:Call, :OnLoopCaught) is nondet
Loop Check.
  159loop_check(Call, LoopCaught):- 
  160  loop_check_term(Call,Call,LoopCaught).
 no_loop_check(:Call) is nondet
No Loop Check.
  168no_loop_check(Call):- no_loop_check(Call, fail).
 no_loop_check(:Call, :LoopCaught) is nondet
No Loop Check.
  176no_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.

  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).
 is_loop_checked(?Call) is nondet
If Is A Loop Checked.
  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    -> (LoopCaught,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    -> (LoopCaught,true)
  237    ;  (Call,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).
 loop_check_term(:Call, +Key, :LoopCaught) is nondet
Loop Check Term 50% of the time
  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).
 get_where(:TermB) is nondet
Get Where.
  281get_where(B:L):-get_where0(F:L),file_base_name(F,B).
 get_where0(:GoalF) is nondet
Get Where Primary Helper.
  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):-!.
 lco_goal_expansion(:TermB, :TermA) is nondet
Lco Call Expansion.
  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.  320system:goal_expansion(LC,Pos,LCO,Pos):- notrace((compound(LC),lco_goal_expansion(LC,LCO)))->LC\=@=LCO