1:- module(call_reorder, [freeze/1,contains_goal/2,freeze_each/2,freeze_atom_concat/3]).    2:- set_module(class(library)).    3/*  Logicmoo Debug Tools
    4% ===================================================================
    5% File 'logicmoo_util_varnames.pl'
    6% Purpose: An Implementation in SWI-Prolog of certain debugging tools
    7% Maintainer: Douglas Miles
    8% Contact: $Author: dmiles $@users.sourceforge.net ;
    9% Version: 'logicmoo_util_varnames.pl' 1.0.0
   10% Revision: $Revision: 1.1 $
   11% Revised At:  $Date: 2002/07/11 21:57:28 $
   12% ===================================================================
   13*/
   14:- meta_predicate(freeze(:)).   15freeze(Goal):-
   16 notrace(term_variables(Goal,Vs)),
   17 (Vs \= [_,_|_] -> call(Goal);
   18   ((
   19    notrace(( \+ (( contains_goal(Goal, call_reorder:freeze(Goal)), nop(dmsg(contains_goal(freeze(Goal)))))))),
   20    notrace(freeze_each(Vs, freeze(Goal)))))).
   21
   22:- meta_predicate(freeze1(:)).   23freeze1(Goal):-
   24 notrace(term_variables(Goal,Vs)),
   25 (Vs \= [_,_|_] -> call(Goal);
   26   ((
   27    notrace(freeze_each(Vs, freeze1(Goal)))))).
   28
   29
   30contains_goal(V,Goal):- term_attvars(V,AVs), !, contains_goal1(AVs,Goal).
   31
   32contains_goal1([],_):-!,fail.
   33contains_goal1([V|Vs],Goal):- (frozen(V,GGs),in_conj(Goal,GGs))->true
   34 ; contains_goal1(Vs,Goal).
   35
   36in_conj(Goal, GG):- in_conj1(Goal, GG).
   37
   38in_conj1(Goal, GG):- Goal == GG -> true ; ( \+ callable(GG) ,!, fail).
   39in_conj1(Goal,(G1,G2)):- Goal == G1 -> true ; in_conj1(Goal,G2).
   40
   41freeze_each([],_Goal):- !.
   42freeze_each([V|Vs],Goal):- freeze(V,Goal), freeze_each(Vs,Goal).
   43
   44freeze_atom_concat(L,R,LR):- freeze(atom_concat(L,R,LR)).
   45
   46:- fixup_exports.