1/* Part of LogicMOO Base Logicmoo Path Setups
    2% ===================================================================
    3% File '$FILENAME.pl'
    4% Purpose: An Implementation in SWI-Prolog of certain debugging tools
    5% Maintainer: Douglas Miles
    6% Contact: $Author: dmiles $@users.sourceforge.net ;
    7% Version: '$FILENAME.pl' 1.0.0
    8% Revision: $Revision: 1.1 $
    9% Revised At:  $Date: 2002/07/11 21:57:28 $
   10% Licience: LGPL
   11% ===================================================================
   12*/
   13% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_body_reorder.pl
   14:- module(logicmoo_util_body_reorder,
   15          [ call_body_reorder/3,
   16            call_body_reorder_compare/4,
   17            enable_body_reorder/0,
   18            timeOfFirstAnswer/2,
   19            timeOfFirstAnswer_0/2,
   20            timeOfFirstAnswer_1/2,
   21            reorderBody/2,
   22            reorderBody/3,
   23            reorderBody/4,
   24            guess_reorder/3,
   25            callClause/1,
   26            make_reordering_key/4,
   27            do_body_reorder/4,
   28            fasterClause/4,
   29            disable_body_reorder/0]).   30
   31
   32:- module_transparent((
   33            call_body_reorder/3,
   34            call_body_reorder_compare/4,
   35            enable_body_reorder/0,
   36            timeOfFirstAnswer/2,
   37            timeOfFirstAnswer_0/2,
   38            timeOfFirstAnswer_1/2,
   39            reorderBody/2,
   40            reorderBody/3,
   41            reorderBody/4,
   42            guess_reorder/3,
   43            callClause/1,
   44            reorder/0,
   45            make_reordering_key/4,
   46            do_body_reorder/4,
   47            fasterClause/4,
   48            disable_body_reorder/0)).   49
   50:- thread_local(t_l:noreorder/0).   51
   52%:- ensure_loaded(logicmoo_util_body_file_scope).
   53:-meta_predicate(call_body_reorder(+,+,+)).   54
   55:-volatile(lmcache:reordering/3).   56:-dynamic(lmcache:reordering/3).   57
   58t_l:noreorder.
   59reorder.
   60
   61reorder_if_var(Var,A,B):- nonvar(Var),!,call(A),call(B).
   62reorder_if_var(Var,A,B):- call(B),call(A).
   63
   64can_reorderBody(_ ,true):-!,fail.
   65can_reorderBody(_ ,Body):-member(M,[did,t_l:noreorder,!,call_body_reorder,call_body_reorder_compare,var,nonvar]),contains_f(M,Body),!,fail.
   66can_reorderBody(_ ,Body):-member(M,[reorder]),contains_f(M,Body),!.
   67% can_reorderBody(Head, _):- reorder_term_expansion,compound(Head),functor(Head, _ ,A),A > 0.
   68
   69:-meta_predicate(do_body_reorder(+,?,+,-)).   70
   71do_body_reorder(_,_,_,_):-!,fail.
   72do_body_reorder(_,_,H,H):- \+ compound(H),!.
   73do_body_reorder(Head,Vars,(A;B),(AA;BB)):- !,do_body_reorder(Head,Vars,A,AA),do_body_reorder(Head,Vars,B,BB).
   74do_body_reorder(Head,_,Body,Body):- \+ can_reorderBody(Head,Body),!.
   75do_body_reorder(Head,Vars,H,HO):-do_body_reorder_e(Head,Vars,H,HO)->H\=@=HO,!.
   76do_body_reorder(Head,[],Body,call_body_reorder(Code,Head,BodyLOut)):- fail,
   77   conj_to_list_reorder(Body,BodyLOut)->BodyLOut=[_,_|_],
   78   gensym(reorderCode,Code),!.
   79do_body_reorder(_,_,Body,Body).
   80
   81do_body_reorder_e(_,_,H,H):- \+ compound(H),!.
   82do_body_reorder_e(Head,_,Body,call_body_reorder(Code,Head,BodyLOut)):- 
   83   Body=..[reorderBody|BodyLOut],!,
   84   gensym(reorderCode,Code).
   85do_body_reorder_e(Head,Vars,H,HO):- 
   86  H=..HL, must_maplist(do_body_reorder_e(Head,Vars),HL,HOL),HO=..HOL.
   87
   88conj_to_list_reorder((A),[A]):- \+ compound(A),!.
   89conj_to_list_reorder((A,B),AB):-!,conj_to_list_reorder(A,AL),conj_to_list_reorder(B,BL),append(AL,BL,AB).
   90conj_to_list_reorder((A),[A]).
   91
   92make_reordering_key(Head,C1,C2,Key):-
   93    term_variables_of_ex(Head,HeadVars),
   94    term_variables_of_ex(C1,C1V),
   95    term_variables_of_ex(C2,C2V),
   96    make_reordering_vkey(HeadVars,C1V,C2V,Key),!.
   97
   98
   99term_variables_of_ex((C2^_),C2V):-!,term_variables(C2,C2V).
  100term_variables_of_ex(C2,C2V):-term_variables(C2,C2V).
  101
  102shared_len(VA,VB,N3):-ord_subtract(VA,VB,Rest),length(Rest,N3).
  103
  104pairify_key(VA,VB,(UA^N3^UB)):- length(VA,N1),length(VB,N2),shared_len(VA,VB,N3),UA is N1-N3,UB is N2-N3.
  105% make_reordering_vkey(HeadVars,C1V,C2V,Key)
  106make_reordering_vkey([],[],[],nonvars).
  107make_reordering_vkey([],[],_ ,h0_a0).
  108make_reordering_vkey([],_ ,[],h0_b0).
  109make_reordering_vkey(_ ,[],[],a0_b0).
  110
  111make_reordering_vkey([],VA,VB,h0(Key)):-pairify_key(VA,VB,Key).
  112make_reordering_vkey(VH,[],VB,a0(Key)):-pairify_key(VH,VB,Key).
  113make_reordering_vkey(VH,VA,[],b0(Key)):-pairify_key(VH,VA,Key).
  114make_reordering_vkey(VH,VA,VB,open(Key1,Key2,Key3)):-pairify_key(VH,VA,Key3),pairify_key(VH,VB,Key1),pairify_key(VA,VB,Key2).
  115
  116reorderBody(C1,C2):- call_body_reorder(anon,2,[C1,C2]).
  117reorderBody(C1,C2,C3):- call_body_reorder(anon,3,[C1,C2,C3]).
  118reorderBody(C1,C2,C3,C4):- call_body_reorder(anon,4,[C1,C2,C3,C4]).
  119
  120lookup_reorder(Key,In,Out):- lmcache:reordering(Key,In,Out),!.
  121save_reorder(Key,In,Out):- call(asserta,lmcache:reordering(Key,In,Out)),!.
  122
  123call_body_reorder_key(_Code,_Head,Key,C1,C2):- notrace(lookup_reorder(Key,(C1,C2),Found)),!,ereq(Found).
  124call_body_reorder_key(_Code,_Head,Key,C1,C2):- notrace(guess_reorder(C1,C2,Reordered)),!,
  125   save_reorder(Key,(C1,C2),Reordered),!,ereq(Reordered).
  126
  127
  128call_body_reorder_compare(Code,Head,C1,C2):- notrace(make_reordering_key(Head,C1,C2,Key)),!,
  129   call_body_reorder_key(Code,Head,Code-Key,C1,C2).
  130
  131
  132make_body_reorderer(Code,Head,[C2,C1],call_body_reorder_compare(Code,Head,C1,C2)):-!.
  133make_body_reorderer(Code,Head,[C3|C12],OUT):- make_body_reorderer(Code,Head,C12,OC12),make_body_reorderer(Code,Head,[OC12,C3],OUT).
  134
  135call_body_reorder(C,CC):-call_body_reorder(C,C,CC).
  136
  137:-meta_predicate(call_body_reorder(+,+,+)).  138call_body_reorder(_Code,_Head,[A]):- !,callClause(A).
  139call_body_reorder(Code,Head,[A|B]):- !,callClause(A),call_body_reorder(Code,Head,B).
  140call_body_reorder(Code,Head,[C1,C2]):- !, call_body_reorder_compare(Code,Head,C1,C2).
  141call_body_reorder(Code,Head,[C1,C2,C3]):- call_body_reorder_compare(Code,Head,call_body_reorder_compare(Code,Head,C1,C2),C3).
  142
  143call_body_reorder(Code,Head,[C1,C2,C3,C4]):- 
  144   call_body_reorder_compare(Code,Head,call_body_reorder_compare(Code,Head,call_body_reorder_compare(Code,Head,C1,C2),C3),C4).
  145
  146% convert 
  147% call_body_reorder(Code,Head,[C1,C2,C3,C4]):- 
  148% to...
  149%   call_body_reorder_compare(Code,Head,call_body_reorder_compare(Code,Head,call_body_reorder_compare(Code,Head,C1,C2),C3),C4).
  150call_body_reorder(Code,Head,List):- reverse(List,Rev),
  151   make_body_reorderer(Code,Head,Rev,OUT),!,ereq(OUT).
  152
  153call_body_reorder(_Code,Head, List):- member(Var^Call,List), ground(Var), !,delete_eq(List,Var^Call,ListO),!,callClause(Call),call_body_reorder(Head,ListO).
  154call_body_reorder(_Code,Head,[A|List]):- !,callClause(A),call_body_reorder(Head,List).
  155call_body_reorder(_Code,Head,C):- dmsg(warn(callClause((Head:-C)))),dtrace,callClause(C).
  156
  157% 999 = error, 888 = fail,  T < 888 actual time
  158timeOfFirstAnswer(C1,Time):- catch((timeOfFirstAnswer_0(C1,Time)*->true;Time=888),Time=999,true).
  159
  160timeOfFirstAnswer_0(C1,TimeVar):-
  161   TimeVar1=e(_), 
  162   timeOfFirstAnswer_1(C1,TimeVar1),
  163   arg(1,TimeVar1,TimeVar).
  164
  165timeOfFirstAnswer_1(C1,TimeVar1):-  
  166   statistics(cputime,Start),
  167   (ereq(C1)*->(ground(TimeVar1)->true;
  168     (statistics(cputime,End),Time is End - Start,
  169        nb_setarg(1,TimeVar1,Time)))).
  170  
  171
  172:-meta_predicate(guess_reorder(0,0,-)).  173guess_reorder(C1,C2,Reordered):-
  174   ( Try1 = ( \+ ( \+ ((C1,C2))))),
  175   ( Try2 = ( \+ ( \+ ((C2,C1))))),
  176   fasterClause(Try1,Try2,T1,T2),!,
  177   (T1<888 ; T2<888),
  178   ( (T1 > T2 ) -> 
  179       Reordered = (C2,C1); 
  180       Reordered = (C1,C2)).
  181
  182:-meta_predicate(fasterClause(0,0,+,+)).  183fasterClause(C1,C2,T1,T2):-  
  184  timeOfFirstAnswer(C1,T1),
  185  catch(catch(call_with_time_limit(T1,
  186     timeOfFirstAnswer_0(C2,T2)),
  187          time_limit_exceeded,T2 is T1+1),_,T2=999).
  188
  189
  190:-meta_predicate(callClause(+)) .  191callClause(_^C):-!,callClause(C).
  192callClause((C0->C1;C2)):-!,(callClause(C0)->callClause(C1);callClause(C2)).
  193callClause((C0*->C1;C2)):-!,(callClause(C0)*->callClause(C1);callClause(C2)).
  194callClause((C0->C1)):-!,(callClause(C0)->callClause(C1)).
  195callClause((C0*->C1)):-!,(callClause(C0)*->callClause(C1)).
  196callClause((C1;C2)):-!,callClause(C1);callClause(C2).
  197callClause((C1,C2)):-!,callClause(C1),callClause(C2).
  198%callClause(C):-debugOnError(ereq(C)).
  199callClause([L|Ist]):- !, dmsg(callClause([L|Ist])),!,call_body_reorder(_ ,[L|Ist]).
  200callClause(C):- on_x_debug(ereq(C)).
  201
  202enable_body_reorder:- enable_in_file(do_body_reorder).
  203disable_body_reorder:- disable_in_file(do_body_reorder).
  204:- disable_body_reorder.  205
  206:- fixup_exports.  207
  208:- if(true).  209% some tests
  210
  211:- endif.