1/* Part of LogicMOO Base Logicmoo Debug Tools
    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
   14:- module(clause_attvars,
   15   [
   16      attr_bind/2,attr_bind/1,
   17      split_attrs/3,
   18      clause_attv/3,
   19      variant_i/2,av_comp/2,
   20      unify_bodies/2,          
   21      clausify_attributes/2,
   22      clausify_attributes4/4
   23    ]).   24
   25:- set_module(class(library)).   26
   27:- module_transparent
   28      attr_bind/2,attr_bind/1,
   29      %clausify_attributes/2,
   30      clausify_attributes4/4,
   31      variant_i/2,av_comp/2,
   32      unify_bodies/2.   33
   34:- create_prolog_flag(assert_attvars,false,[keep(true)]).   35
   36split_attrs(B,true,B0):-var(B),!,B0=call(B).
   37split_attrs(call(C),A,B):-!,split_attrs(C,A,B).
   38split_attrs(M:B,ATTRS,BODY):- is_visible_module(M),!, split_attrs(B,ATTRS,BODY).
   39split_attrs(B,true,B0):-ground(B),!,B0=B.
   40
   41/*
   42split_attrs(B,ATTRS,BODY):- \+ sanity((simple_var(ATTRS),simple_var(BODY))),
   43    dtrace,dumpST,dtrace(split_attrs(B,ATTRS,BODY)).
   44*/
   45split_attrs(M:attr_bind(G,Call),M:attr_bind(G),Call):- !.
   46split_attrs(attr_bind(G,Call),attr_bind(G),Call):- !.
   47split_attrs(true,true,true):-!.
   48split_attrs(_:true,true,true):-!.
   49split_attrs(M:A,M:ATTRS,M:BODY):- !,split_attrs(A,ATTRS,BODY).
   50split_attrs(attr_bind(G),attr_bind(G),true):- !.
   51split_attrs((A,B),ATTRS,BODY):- !,
   52  split_attrs(A,AA,AAA),
   53  split_attrs(B,BB,BBB),!,
   54  conjoin(AA,BB,ATTRS),
   55  conjoin(AAA,BBB,BODY).
   56
   57split_attrs(AB,true,AB).
   58
   59:- meta_predicate attr_bind(+).   60:- module_transparent attr_bind/1.   61attr_bind(Attribs):- dont_make_cyclic(catch(maplist(call,Attribs),error(uninstantiation_error(_),_),fail)).
   62
   63:- meta_predicate attr_bind(+,0).   64:- module_transparent attr_bind/2.   65attr_bind(Attribs,Call):- attr_bind(Attribs),Call.
   66
   67
   68clause_attv(H,B,R):- nonvar(R),!, 
   69  dont_make_cyclic((must(system:clause(H0,BC,R)),
   70    must(split_attrs(BC,AV,B0)),!,
   71    must((catch(AV,error(uninstantiation_error(_),_),fail),!,unify_bodies(B0,B),H=H0)))).
   72
   73clause_attv(M:H0,B0,Ref):- !,
   74 quietly(copy_term(H0:B0, H:B, Attribs)),
   75 dont_make_cyclic((    
   76    (M:clause(H,BC,Ref),
   77       split_attrs(BC,AV,BB), unify_bodies(B,BB) , AV , unify_bodies(H0,H),unify_bodies(B0,B),
   78        attr_bind(Attribs)))).
   79
   80clause_attv(H0,B0,Ref):-
   81 quietly(copy_term(H0:B0, H:B, Attribs)),
   82 dont_make_cyclic((    
   83    (clause(H,BC,Ref),
   84       split_attrs(BC,AV,BB), unify_bodies(B,BB) , AV , unify_bodies(H0,H),unify_bodies(B0,B),
   85        attr_bind(Attribs)))).
   86
   87unify_bodies(B1,B2):-strip_module(B1,M1,BB1),strip_module(B2,M2,BB2),(B2\==BB2;B1\==BB1),!,M1=M2,unify_bodies(BB1,BB2).
   88unify_bodies(B1,B2):- (\+ compound(B1);\+ compound(B2)),!,B1=B2.
   89unify_bodies(B1,B2):- B1=..[F|BB1],B2=..[F|BB2],context_module(M),maplist(M:unify_bodies,BB1,BB2).
   90
   91/*
   92
   93clause_attv(MH,B,Ref):- 
   94 dont_make_cyclic((
   95   % must(modulize_head(MH,M:H)),
   96   system:clause(MH,BMC,Ref),
   97    ((compound(BMC),BMC = attr_bind(Attribs,BOUT)) -> (attr_bind(Attribs)) ; BMC=BOUT))),
   98 dont_make_cyclic((BOUT=B)).
   99*/
  100/*
  101clause_attv(MH,B,Ref):- !,
  102 no_repeats(Ref,(must(modulize_head(MH,M:H)),system:clause(M:H,BMC,Ref))),
  103   ((compound(BMC),BMC = attr_bind(Attribs,BM)) -> true ; (BMC=BM -> Attribs=[])),
  104 BM = B,
  105 once(attr_bind(Attribs)).
  106
  107  */
  108/*
  109clause_attv(H0,BIn,Ref):- 
  110    copy_term_nat(H0:BIn,H:B0),
  111    system:clause(H,BC,Ref),
  112  (must(quietly(split_attrs(BC,AV,B))) -> ( B=B0 -> AV -> H=H0 -> BIn=B)).
  113*/
  114% clause_attv(H00,B000,Ref):- unnumbervars((H00:B000),(H:B0)), split_attrs(B0,_A,B),!,clause_i(H,B,Ref), (clause_i(HH,BB,Ref),HH=@=H,BB=@=B,A).
  115% clause_attv(H,B,Ref):- system:clause(H,AB,Ref), (must(split_attrs(AB,A,B0)->A),B=B0).
  116
  117clausify_attributes(Data,THIS):- notrace(clausify_attributes0(Data,THIS)).
  118clausify_attributes0(V,V):- \+ current_prolog_flag(assert_attvars,true),!.
  119
  120clausify_attributes0(Data,THIS):- attvar(Data), clausify_attributes_helper(Data,THIS).
  121clausify_attributes0(V,V):- \+ compound(V),!.
  122%clausify_attributes(:-(V),:-(V)):-!.
  123clausify_attributes0(M:Data,M:THIS):- !,clausify_attributes(Data,THIS).
  124clausify_attributes0([H|T],[HH|TT]):- !,clausify_attributes(H,HH),clausify_attributes(T,TT).
  125%clausify_attributes((H,T),(HH,TT)):- !,clausify_attributes(H,HH),clausify_attributes(T,TT).
  126clausify_attributes0(Data,THIS):- clausify_attributes_helper(Data,THIS).
  127
  128clausify_attributes_helper(Data,THIS):-  term_attvars(Data,Vars),Vars=[_|_],maplist(del_attr_type(vn),Vars),!,copy_term(Data,DataC,Attribs),expand_to_hb(DataC,H,B),clausify_attributes4(H,B,Attribs,THIS),!.
  129clausify_attributes_helper(Data,Data).
  130
  131
  132clausify_attributes4(H,B,[],(H:-B)):-!.
  133clausify_attributes4(H,B,Extra,(H:-attr_bind(Extra,B))).
  134
  135variant_i(A,B):- A=@=B,!.
  136variant_i(A,B):- copy_term_nat(A:B,AA:BB), \+(AA=@=BB),!,fail.
  137variant_i(A,B):- term_variables(A,AV),AV\==[], 
  138   term_variables(B,BV),
  139   (maplist(av_comp,AV,BV)->!;(dtrace,maplist(av_comp,AV,BV))).
  140
  141% % % OFF :- system:use_module(library(gvar_lib)).
  142
  143av_comp(A,B):-get_attrs(A,AA),get_attrs(B,BB),AA=@=BB,!.
  144av_comp(A,B):-get_attrs(A,attr(_,_,AB1)),!,AB1\==[],get_attrs(B,attr(_,_,AB2)),!,AB1==AB2.
  145av_comp(_A,_B):-!.
  146
  147:- fixup_exports.