    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/1,
   18          is_parent_goal/2,
   19            lc_tcall/1
   20          ]).

Utility LOGICMOO LOOP CHECK

This module prevents infinite loops.

author: - Douglas R. Miles
license: - LGPL */

   28:- set_module(class(library)).   29
   30% :- autoload(library(apply),[maplist/2, maplist/3]).
   31:- system:use_module(library(lists)).   32:- system:use_module(library(apply)).   33:- system:use_module(library(yall)).   34:- system:use_module(library(threadutil)).   35:- system:use_module(library(debug)).   36
   37:- module_transparent((is_loop_checked/1,
   38            lco_goal_expansion/2,            
   39            cyclic_break/1,
   40
   41            loop_check_early/2,loop_check_term/3,
   42            loop_check_term/3,no_loop_check_term/3,loop_check_term_frame/5,
   43            
   44            loop_check/1,loop_check/2,no_loop_check/1,no_loop_check/2,
   45            current_loop_checker/1,
   46            push_loop_checker/0,
   47            pop_loop_checker/0,
   48            transitive/3,
   49            transitive_except/4,
   50            transitive_lc/3,
   51            lc_tcall/1)).   52
   53:- set_module(class(library)).  
   54% % % OFF :- system:use_module(library(apply)).
   55
   56% WAS OFF  :- system:use_module(library(tabling)).
   57% % % OFF :- system:use_module(library(logicmoo/each_call)).% WAS OFF  :- system:use_module(library(logicmoo_startup)).
   58
   59
   60:- meta_predicate  
   61        lc_tcall(0),
   62
   63        loop_check(0), loop_check(0, 0),
   64        no_loop_check(0), no_loop_check(0, 0),
   65        
   66        loop_check_early(0, 0), loop_check_term(0, ?, 0),
   67
   68        % loop_check_term(0, ?, 0),no_loop_check_term(0, ?, 0),
   69        
   70        %transitive(2, +, -),
   71        transitive_except(+, 2, +, -),
   72        transitive_lc(2, +, -).   73        
   74/* memoize_on(+,+,0), memoize_on(+,+,+,0), */
   75
   76
   77:- module_transparent
   78        can_fail/1,
   79        get_where/1,
   80        get_where0/1,
   81        is_loop_checked/1,
   82        lco_goal_expansion/2.

transitive(:PRED2X, +A, -B) is nondet: Transitive.

   92transitive(XY,A,A):- XY=[],!.
   93transitive(XY,A,B):- XY= [X|Y], !, transitive(X,A,M),!, transitive(Y,M,B).
   94transitive(X,A,B):- once(on_x_debug(call(X,A,R)) -> ( R\=@=A -> transitive_lc(X,R,B) ; B=R); B=A),!.
   95
   96
   97non_transitive(XY,A,A):- XY=[],!.
   98non_transitive(XY,A,B):- XY= [X|Y], !, non_transitive(X,A,M),!, non_transitive(Y,M,B).
   99non_transitive(X,A,B):- once(on_x_debug(call(X,A,B))),!.
  100non_transitive(_,A,A).

transitive_lc(:PRED2X, +A, -B) is nondet: Transitive Not Loop Checked.

  109transitive_lc(XY,A,A):- XY=[],!.
  110transitive_lc(XY,A,B):- XY= [X|Y],!,transitive_except([],X,A,M),transitive_lc(Y,M,B).
  111transitive_lc(X,A,B):-transitive_except([],X,A,B).

transitive_except(+NotIn, :PRED2X, +A, -B) is nondet: Transitive Except.

  120transitive_except(NotIn,X,A,B):- memberchk_same_two(A,NotIn)-> (B=A,!) ;
  121  ((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.

  130memberchk_same_two(X, [Y0|Ys]) :- is_list(Ys),!,C=..[v,Y0|Ys],!, arg(_,C,Y), ( X =@= Y ->  (var(X) -> X==Y ; true)),!.
  131memberchk_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.

  138cyclic_break(Cyclic):- notrace(cyclic_term(Cyclic))->(writeq(cyclic_break(Cyclic)),nl,prolog);notrace(true).
  139
  140
  141% ===================================================================
  142% Loop checking
  143% ===================================================================
  144:- thread_local lmcache:ilc/2.  145:- thread_local lmcache:ilc/3.  146
  147% = :- meta_predicate(lc_tcall(0)).
  148% lc_tcall(C0):-reduce_make_key(C0,C),!,table(C),!,query(C).
  149% lc_tcall(C0):-query(C).

lc_tcall(:GoalC) is nondet: Call Tabled

  157:- meta_predicate(lc_tcall(0)).  158%:- table(lc_tcall/1).
  159lc_tcall(G):- loop_check(call(G)).

loop_check_early(:Call, :LoopCaught) is nondet: Loop Check Early.

  167loop_check_early(Call, LoopCaught):- loop_check(Call, LoopCaught).

loop_check(:Call) is nondet: Loop Check.

  175loop_check(Call):- loop_check(Call, fail).

loop_check(:Call, :OnLoopCaught) is nondet: Loop Check.

  183loop_check(Call, LoopCaught):- 
  184  loop_check_term(Call,Call,LoopCaught).

no_loop_check(:Call) is nondet: No Loop Check.

  192no_loop_check(Call):- no_loop_check(Call, fail).

no_loop_check(:Call, :LoopCaught) is nondet: No Loop Check.

  200no_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.

  208no_loop_check_term(Call,Key,LoopCaught):- 
  209   trusted_redo_call_cleanup(push_loop_checker,
  210                     loop_check_term(Call,Key,LoopCaught),
  211                     pop_loop_checker).
  212
  213:- thread_initialization(nb_setval('$loop_checker',1)).  214:- initialization(nb_setval('$loop_checker',1),restore).  215current_loop_checker(LC):- ((nb_current('$loop_checker',LC),number(LC))->true;LC=0).
  216push_loop_checker :- current_loop_checker(LC),LC2 is LC+1,nb_setval('$loop_checker',LC2).
  217pop_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.

  224is_loop_checked(Key):- 
  225  prolog_current_frame(Frame),
  226  notrace(make_frame_key(Key,Frame,KeyS,GoaL,SearchFrame)),
  227  loop_check_term_frame(fail,KeyS,GoaL,SearchFrame,true).
  228
  229
  230make_frame_key(Key,Frame,Part1,Part2,Parent1):-
  231  prolog_frame_attribute(Frame,parent,Parent1),
  232  make_key(Key,Part1,Part2).
  233
  234:- '$hide'(make_frame_key/5).  235
  236make_key(key(Part1),Part1,Part2):-!,current_loop_checker(Part2).
  237make_key(key(Key,GoaLs),Part1,Part2):-!,current_loop_checker(LC),make_key5(Key,GoaLs,LC,Part1,Part2).
  238make_key(Key,Key,Part2):- ground(Key),!,current_loop_checker(Part2).
  239make_key(Key,Part1,Part2):- copy_term(Key,KeyS,GoaLs),current_loop_checker(LC),make_key5(KeyS,GoaLs,LC,Part1,Part2).
  240
  241make_key5(Part1,[],LC,Part1,LC):-!,numbervars(Part1,242,_,[attvar(error)]).
  242make_key5(Part1,GoaLs,LC,Part1,[LC|GoaLs]):-numbervars(Part1+GoaLs,242,_,[attvar(error)]).
  243
  244
  245     
  246% :- meta_predicate(loop_check_term_frame(+,+,+,+,:)).
  247loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught):- 
  248 % set_prolog_flag(debug,true),
  249 set_prolog_flag(last_call_optimisation,false),
  250 % set_prolog_flag(gc,false),
  251 !, 
  252 (prolog_frame_attribute(SearchFrame, parent_goal, loop_check_term_frame(_,KeyS,GoaL,_,_)) 
  253   -> LoopCaught ;  Call).
  254
  255
  256%   (loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught),true)),true.
  257
  258/*
  259loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught):- 
  260 % set_prolog_flag(debug,true),
  261 set_prolog_flag(last_call_optimisation,false),
  262 % set_prolog_flag(gc,false),
  263 !,
  264   (prolog_frame_attribute(SearchFrame, parent_goal, loop_check_term_frame(_,KeyS,GoaL,_,_))
  265    -> (LoopCaught,true)
  266    ;  (loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught),true)),true.
  267
  268loop_check_term_frame_grovel(Call,KeyS,GoaL,SearchFrame,LoopCaught):-  !,
  269  (  notrace(parent_frame_goal_0(SearchFrame, loop_check_term_frame_grovel(_,KeyS,GoaL,_,_)))
  270    -> (LoopCaught,true)
  271    ;  (Call,true)).
  272*/
  273
  274is_parent_goal(G):- prolog_current_frame(F),is_parent_goal(F,G).
  275% The user must ensure the checked parent goal is not removed from the stack due 
  276% to last-call optimisation 
  277is_parent_goal(F,G):- nonvar(G),prolog_frame_attribute(F,parent_goal, G).
  278%and be aware of the slow operation on deeply nested calls.
  279is_parent_goal(F,G):- prolog_frame_attribute(F,parent,P),parent_frame_goal(P,G).
  280
  281parent_frame_goal(F,V):- parent_frame_goal_0(F,V0),contains_goalf(V0,V).
  282parent_frame_goal_0(F,V):- prolog_frame_attribute(F,goal,V);
  283   (prolog_frame_attribute(F,parent,P),parent_frame_goal_0(P,V)).
  284
  285contains_goalf(V0,V):- nonvar(V),same_goalf(V0,V),!.
  286contains_goalf(V0,_):- \+ compound(V0),!,fail.
  287contains_goalf(V0,V):- var(V),same_goalf(V0,V).
  288contains_goalf(_:V0,V):- !, contains_goalf(V0,V).
  289contains_goalf('$execute_directive_3'(V0),V):-!, same_goalf(V0,V).
  290contains_goalf('<meta-call>'(V0),V):-!, same_goalf(V0,V).
  291contains_goalf(catch(V0,_,_),V):- same_goalf(V0,V).
  292contains_goalf(catch(_,_,V0),V):- same_goalf(V0,V).
  293same_goalf(V,V).

loop_check_term(:Call, +Key, :LoopCaught) is nondet: Loop Check Term 50% of the time

  301%loop_check_term(Call,_Key,_LoopCaught):- zotrace((current_prolog_flag(unsafe_speedups , true) , 1 is random(2))),!,call(Call).
  302% loop_check_term(Call,_Key,_LoopCaught):-!,Call.
  303
  304loop_check_term(Call,Key,LoopCaught):- 
  305   prolog_current_frame(Frame),
  306   notrace(make_frame_key(Key,Frame,KeyS,GoaL,SearchFrame)),
  307   loop_check_term_frame(Call,KeyS,GoaL,SearchFrame,LoopCaught).

get_where(:TermB) is nondet: Get Where.

  314get_where(B:L):-get_where0(F:L),file_base_name(F,B).

get_where0(:GoalF) is nondet: Get Where Primary Helper.

  321get_where0(F:L):-source_location(file,F),current_input(S),line_position(S,L),!.
  322get_where0(F:L):-source_location(F,L),!.
  323get_where0(A:0):-current_input(S),stream_property(S,alias(A)),!.
  324get_where0(M:0):-source_context_module(M),!.
  325get_where0(baseKB:0):-!.

lco_goal_expansion(:TermB, :TermA) is nondet: Lco Call Expansion.

  335lco_goal_expansion(V,VV):- \+ compound(V),!,V=VV.
  336lco_goal_expansion(loop_check(G),O):-lco_goal_expansion(loop_check(G,fail),O),!.
  337lco_goal_expansion(no_loop_check(G),O):-lco_goal_expansion(no_loop_check(G,fail),O),!.
  338lco_goal_expansion(loop_check(G,LoopCaught),loop_check_term(G,info(G,W),LoopCaught)):- get_where(W),!.
  339lco_goal_expansion(no_loop_check(G,LoopCaught),no_loop_check_term(G,info(G,W),LoopCaught)):- get_where(W),!.
  340lco_goal_expansion(B,A):- 
  341  compound_name_arguments(B,F,ARGS),
  342  F \== (meta_predicate),
  343  maplist(lco_goal_expansion,ARGS,AARGS),
  344  compound_name_arguments(A,F,AARGS),!.
  345lco_goal_expansion(A,A).
  346
  347:- if(current_predicate(fixup_exports/0)).  348:- fixup_exports.  349:- endif.  350
  351:- multifile system:goal_expansion/4.  352:- dynamic system:goal_expansion/4.  353% system:goal_expansion(LC,Pos,LCO,Pos):- notrace((compound(LC),lco_goal_expansion(LC,LCO),LC\=@=LCO)).