1% ===================================================================
    2% File 'logicmoo_util_ctx_frame.pl'
    3% Purpose: An Implementation in SWI-Prolog of Unwindable context frames
    4% Maintainer: Douglas Miles
    5% Contact: $Author: dmiles $@users.sourceforge.net ;
    6% Version: 'logicmoo_util_ctx_frame.pl' 1.0.0
    7% Revision:  $Revision: 1.1 $
    8% Revised At:   $Date: 2002/07/11 21:57:28 $
    9% ===================================================================
   10% ===================================================================
   11:- module(logicmoo_util_bb_frame, [all_different_bindings/1]).   12
   13:- use_module(pretty_clauses).   14
   15nb_current_no_nil(N,V):- nb_current(N,V),V\==[].
   16
   17was_named_graph(NG,Name,Info2):- compound(NG),compound_name_arguments(NG,named_graph,[Name,Info1]), nonvar(Info1), var(Info2), Info1=Info2.
   18
   19push_frame(Info,Frame):- atom(Frame),must(nb_current_no_nil(Frame,CG)),!,push_frame(Info,CG).
   20%push_frame(named_graph(Name,Info), Frame):- var(Frame),!,named_graph(Name,Info)=Frame. 
   21%push_frame(named_graph(Name,Info), Frame):- named_graph(Name,Info)=Frame,!.
   22push_frame(Info, _Frame):- var(Info),!.
   23push_frame(Info, Frame):- var(Frame), nb_current_no_nil(named_graph,F),
   24  compound_name_arguments(Frame,named_graph,[F,[]]), !,
   25  push_frame(Info, Frame).
   26
   27push_frame(Info, Frame):- var(Frame), !, gensym(frame, F), compound_name_arguments(Frame, named_graph,[anonymous(F),[]]), push_frame(Info, Frame).
   28
   29
   30push_frame(Cmpd1, Cmpd2):-was_named_graph(Cmpd1,Name1, Info), was_named_graph(Cmpd2, Name2, Frame), Name1==Name2, !,push_frame(Info, Frame).
   31push_frame(Cmpd, Frame):- was_named_graph(Cmpd, Name, Info2), was_named_graph(Info2, Name, Info), !, 
   32  compound_name_arguments(NewArg,named_graph,[Name,Info]),
   33  push_frame(NewArg, Frame).
   34push_frame(Cmpd, Frame):- was_named_graph(Cmpd,_Name, Info2), was_named_graph(Info2, Name, Info), !, 
   35  compound_name_arguments(NewArg,named_graph,[Name,Info]),
   36  push_frame(NewArg, Frame).
   37push_frame(Cmpd,_Frame):- was_named_graph(Cmpd,_Name, Info2), Info2 ==[].
   38/*
   39push_frame(named_graph(Name,[H|List]), Frame):- fail, nonvar(H),!,
   40 push_frame(named_graph(Name,H), Frame),
   41 push_frame(named_graph(Name,List), Frame).
   42*/
   43push_frame(Cmpd, Frame):- was_named_graph(Cmpd, anonymous(_),Info), !, push_frame(Info, Frame).
   44push_frame(Cmpd, Frame):- was_named_graph(Cmpd, Name, Info),
   45   compound_sub_term(Sub, Frame), 
   46   was_named_graph(Sub, Name, SubFrame), !, 
   47   push_frame(Info, SubFrame).
   48
   49
   50push_frame(Info, call(Frame)):- !,call(Frame,Info),!.
   51push_frame(Info, cg(Frame)):- !, push_frame(Info, Frame),!.
   52push_frame(Info, _Frame):- Info==[],!.
   53push_frame([I1|I2], Frame):- !, push_frame(I1, Frame), push_frame(I2, Frame).
   54push_frame('&'(I1,I2), Frame):- !, push_frame(I1, Frame), push_frame(I2, Frame).
   55
   56push_frame(Info, Frame):- do_eval_or_same(Info, BetterInfo), Info\=@=BetterInfo, push_frame(BetterInfo, Frame).
   57
   58push_frame(Info, Frame):- member(Sub, Frame), Sub==Info, !.
   59push_frame(Info, Frame):- Frame = [H|T],!, setarg(2, Frame, [H|T]), setarg(1, Frame, Info).
   60push_frame(Info, Frame):- compound(Frame), functor(Frame,_,A),arg(A,Frame,E),
   61  (E == [] -> setarg(A,Frame,[Info]) ; push_frame(Info, E)).
   62
   63get_frame(Frame, Frame):- \+ (Frame= cg(_)),!.
   64get_frame(cg(Frame), Frame):-!.
   65
   66
   67compound_sub_term(X, X).
   68compound_sub_term(X, Term) :- 
   69    compound(Term), 
   70    \+ functor(Term,preconds,_),
   71    arg(_, Term, Arg), 
   72    compound(Arg),
   73    compound_sub_term(X, Arg).
   74
   75%  LocalContexts
   76%   They hold name-values in
   77%     -- assoc/1 lists
   78%     -- open tailed lists
   79%     -- frame/1 contains one or more of the above
   80
   81% v/3s 
   82%  = v(Value,Setter,KeyDestructor)
   83
   84% frame/3s
   85%  = frame(Named,Destructor,Ctx)
   86
   87% well i played with a couple few differnt environment impls.. they have their pros cons.. one impl.. 
   88% that was unique is that an array of "binding pairs" live in an arraylist.. to be "in" an environment 
   89% it meant that you held an "index" into the arry list that as you went backwards you'd find your bindings.. each symbol had a java ftInt field "lastBindingIndex" 
   90% .. that was a "hint" to where you could fastforward the backwards search .. end named binding context also had a "index" to when you leave a named block.. 
   91% you could quickly reset the top of an index.
   92% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_ctx_frame.pl
   93
   94do_eval_or_same(G, GG):- \+ compound(G), !, GG=G.
   95do_eval_or_same([G1|G2], [GG1|GG2]):- !, do_eval_or_same(G1, GG1), do_eval_or_same(G2, GG2).
   96do_eval_or_same({O}, {O}):- !.
   97do_eval_or_same(G, GG):- compound_name_arguments(G, HT, [F|GL]), atom(F), member(HT, [t, h]), !,
   98 compound_name_arguments(GM, F, GL), !, do_eval_or_same(GM, GG).
   99
  100do_eval_or_same(textString(P, G), textString(P, GG)):- ground(G), must(to_string_lc(G, GG)), !.
  101/*
  102do_eval_or_same(PEG, PEGG):- xnotrace((compound_name_arguments(PEG, F, Args), downcase_atom(F, D), (atom_concat(_, 'text', D);atom_concat(_, 'string', D)),
  103  append(Left, [G], Args))), ground(G), \+ string(G), !, must(to_string_lc(G, GG)), !,
  104  append(Left, [GG], NewArgs), compound_name_arguments(PEGG, F, NewArgs).
  105*/
  106do_eval_or_same(iza(P, G), Out):- !, do_eval_or_same(isa(P, G), Out). 
  107do_eval_or_same(isa(P, G), isa(P, GG)):- ground(G), !, must(asCol(G, GG)), !.
  108
  109do_eval_or_same(xfn(P, G), GG):- !, must( call(P, G, GG)), !.
  110do_eval_or_same(G, GG):- compound_name_arguments(G, F, GL), F\==percept_props, !,
  111 maplist(do_eval_or_same, GL, GGL), !, compound_name_arguments(GG, F, GGL).
  112do_eval_or_same(G, G).
  113
  114
  115get_frame_vars(Frame,FVs):-
  116  get_frame(Frame,List), 
  117  setof(Var,(sub_term(Var,List),compound(Var),functor(Var,frame_var,_)),FVs),!.
  118get_frame_vars(Frame,FVs):-
  119  get_frame(Frame,List), 
  120  setof(frame_var(Var, RealVar),frame_var(Var,List,RealVar),FVs),!.
  121get_frame_vars(_Frame,[]).
  122
  123
  124
  125merge_simular_graph_vars(CG,PCG):- 
  126  get_frame_vars(CG,FV),
  127  get_frame_vars(PCG,PFV),
  128  combine_gvars(FV,FV),
  129  combine_gvars(PFV,PFV),
  130  combine_gvars(PFV,FV),
  131  combine_gvars(FV,PFV),!.
  132
  133combine_gvars([],_):-!.
  134combine_gvars(_,[]):-!.
  135combine_gvars([S|S1],S2):- ignore(member(S,S2)),
  136  combine_gvars(S1,S2).
  137
  138
  139merge_simular_vars([],[]):-!.
  140merge_simular_vars([One|Rest],List):-  member(One,Rest),merge_simular_vars(Rest,List),!.
  141merge_simular_vars([One|Rest],[One|List]):-  merge_simular_vars(Rest,List),!.
  142
  143resolve_frame_constants(CG0,CG):-
  144 get_frame_vars(CG0,FVs),
  145 merge_simular_vars(FVs,SFVs),
  146 resolve_frame_constants(SFVs,CG0,CG1),
  147 must(correct_frame_preds(CG1,CG)).
  148
  149event_frame_pred('agnt').
  150event_frame_pred('inst').
  151
  152correct_frame_preds([H|CG1],CG):- !, 
  153  correct_frame_preds(H,H1),!,
  154  correct_frame_preds(CG1,CG2),
  155  flatten([H1,CG2],CG).
  156
  157correct_frame_preds(FrameP,FramePO):- compound(FrameP),
  158  compound_name_arguments(FrameP,F,[A,B|C]),
  159  %downcase_atom(F,DC),
  160  =(F,DC),
  161  compound_name_arguments(FramePO,DC,[A,B|C]), !,  
  162  ignore((event_frame_pred(DC) -> debug_var('_Event',A), nop(debug_var('Doer',B)))).
  163correct_frame_preds(CG,CG).
  164
  165resolve_frame_constants([],IO,IO):-!.
  166resolve_frame_constants([DoConst|More],Props,Out):- !, 
  167  resolve_frame_constants(DoConst,Props,Mid),
  168  resolve_frame_constants(More,Mid,Out).
  169resolve_frame_constants(frame_var(Var, RealVar),Props,Out):-
  170  downcase_atom(Var,VarD),
  171  upcase_atom(Var,VarU),
  172  % sUbst(Props,frame_var(Var, RealVar),[],Mid),
  173  sUbst_each(Props,[
  174
  175  ?(RealVar)=RealVar,?(Var)=RealVar,?(VarD)=RealVar,?(VarU)=RealVar,
  176  *(RealVar)=RealVar,*(Var)=RealVar,*(VarD)=RealVar,*(VarU)=RealVar,
  177      Var=RealVar,VarU=RealVar,VarD=RealVar],Out),!.
  178resolve_frame_constants(_,Mid,Mid).
  179
  180
  181frame_var(_, Frame, _):- \+ compound(Frame), !, fail.
  182frame_var(Name, cg(Frame), Var):- !, frame_var(Name, Frame, Var).
  183frame_var(Name, Frame, Var):- nonvar(Var), !, frame_var(Name, Frame, NewVar), !, NewVar=Var.
  184frame_var(Name, Frame, Var):- compound(Name), !, arg(_, Name, E), frame_var(E, Frame, Var), !.
  185frame_var(Name, [Frame1|Frame2], Var):- !, (frame_var(Name, Frame1, Var);frame_var(Name, Frame2, Var)).
  186frame_var(Name, frame_var(Prop, Var),Var):- !, same_name(Name, Prop).
  187frame_var(Name, cg_name(Var, Prop),Var):- !, same_name(Name, Prop).
  188frame_var(Name, Prop = Var, Var):- !, same_name(Name, Prop).
  189frame_var(Name, f(Pred, 1, [Var]), Var):- !, same_name(Name, Pred).
  190frame_var(Name, f(_, _, [Prop|List]), Var):- !, same_name(Name, Prop), last(List, Var).
  191frame_var(Name, Frame, Var):- fail, compound_name_arity(Frame, Pred, Arity), Arity > 0, compound_name_arguments(Frame, Pred, List),
  192  frame_var(Name, f(Pred, Arity, List), Var).
  193frame_var(Name, Frame, Var):- arg(_, Frame, E), frame_var(Name, E, Var), !.
  194
  195asCol(A, A):- var(A), !.
  196asCol(A, 'TypeFn'(A)):- \+ callable(A), !.
  197asCol(A, S):- format(atom(S), '~w', [A]).
  198
  199to_upcase_name(V, V):- var(V), !.
  200to_upcase_name('$VAR'(T), N):- !, to_upcase_name(T, N).
  201to_upcase_name('?'(T), N):- !, to_upcase_name(T, N).
  202to_upcase_name('*'(T), N):- !, to_upcase_name(T, N).
  203to_upcase_name(T, N):- compound(T), !, compound_name_arity(T, A, _), !, to_upcase_name(A, N).
  204to_upcase_name(T, N):- format(atom(A), '~w', [T]), upcase_atom(A, N).
  205
  206to_downcase_name(V, N):- var(V), !, N = V.
  207to_downcase_name('$VAR'(T), N):- !, to_downcase_name(T, N).
  208to_downcase_name('?'(T), N):- !, to_downcase_name(T, N).
  209to_downcase_name('*'(T), N):- !, to_downcase_name(T, N).
  210to_downcase_name(T, N):- compound(T), !, compound_name_arity(T, A, _), !, to_downcase_name(A, N).
  211to_downcase_name(T, N):- format(atom(A), '~w', [T]), downcase_atom(A, N).
  212
  213same_name(T1, T2):- var(T1),!,ground(T2), to_downcase_name(T1,T2).
  214same_name(T1, T2):- T1 = T2,!.
  215same_name(T1, T2):- ground(T1), ground(T2), to_upcase_name(T1, N1), to_upcase_name(T2, N2), !, N1==N2.
  216
  217
  218
  219%frame_to_asserts(List, cmdFrame(Frame)):- is_list(List), sort(List, ListR), list_to_conjuncts('&', ListR, Frame), !.
  220%frame_to_asserts(Frame, cmdFrame(Frame)).
  221frame_to_asserts(Frame, Asserts):- get_frame(Frame, Asserts),!.
  222
  223frame_defaults([], _Frame):-!.
  224frame_defaults([FrameArg| FrameArgS], Frame):-
  225   ignore((
  226     member(var(NewArg), FrameArg), var(NewArg),
  227     member(default(D), FrameArg),
  228     debug_var(D, NewArg),
  229    % D=NewArg,
  230   !)),
  231   frame_defaults(FrameArgS, Frame).
  232
  233subst_into_list([], []).
  234subst_into_list(+(AB), [optional(true)|AABB]):- !, subst_into_list(AB, AABB), !.
  235subst_into_list(A+B, AABB):-!, subst_into_list(A, AA), subst_into_list(B, BB), append(AA, BB, AABB).
  236subst_into_list([A|B], AABB):-!, subst_into_list(A, AA), subst_into_list(B, BB), append(AA, BB, AABB).
  237subst_into_list(A, [A]):-!.
  238
  239fix_frame_args([], []).
  240fix_frame_args([LastArg, []], BetterFrameArgS):- !, fix_frame_args([LastArg], BetterFrameArgS).
  241fix_frame_args([FrameArg| FrameArgS], [[slot(Slot)|FrameArgL]|BetterFrameArgS]):-
  242  subst_into_list(FrameArg, FrameArgL),
  243  ignore(member(var(NewArg), FrameArgL)),
  244  ignore((member(default(Name), FrameArgL), functor(Name, F, _), debug_var(F, NewArg), debug_var(F, Slot))),
  245  fix_frame_args(FrameArgS, BetterFrameArgS).
  246
  247compute_frame_slots([], []).
  248compute_frame_slots([FrameArg| FrameArgS], [FrameSlot|FrameSlotS]):-
  249  frame_arg_to_slot(FrameArg, FrameSlot),
  250  compute_frame_slots(FrameArgS, FrameSlotS).
  251compute_frame_slots([_FrameArg| FrameArgS], FrameSlotS):-
  252  compute_frame_slots(FrameArgS, FrameSlotS).
  253
  254frame_arg_to_slot(FrameArg, Name=NewArg):-
  255   % \+ member(optional(true), FrameArg),
  256   (member(var(NewArg), FrameArg);member(slot(NewArg), FrameArg)), !,
  257   (member(pred(Name), FrameArg);member(prep(Name), FrameArg);member(default(Name), FrameArg)), !.
  258
  259frmprint(Frame) :- get_frame(Frame,GFrame),frmprint0(GFrame).
  260frmprint0(Frame) :- \+ is_list(Frame),!,frmprint_e(Frame).
  261frmprint0(I) :-
  262    catch(make_pretty(I, Frame), _, I=Frame),
  263    guess_pretty(Frame),
  264    predsort(frcmp, Frame, FrameA),
  265    reverse(FrameA, FrameO),
  266    frmprint_e(FrameO).
  267frmprint_e(I) :- 
  268 pretty_clauses:((
  269  catch(make_pretty(I, Frame), _, I=Frame),
  270    guess_pretty(Frame),
  271 with_output_to(atom(A),print_tree_nl(Frame)), format('~N~w~n', [A]))).
  272
  273sortDeref(P, PP):- \+ compound(P), !, P=PP.
  274%sortDeref(isa(X, Y), visa(X, Y)):-!.
  275sortDeref(~(P), PP):-!, sortDeref(P, PP).
  276sortDeref(P, PP):- arg(1, P, PP), compound(PP).
  277sortDeref(P, PP):- safe_functor(P, F, N), wrapper_funct_sortin(F), arg(N, P, E), !, sortDeref(E, PP).
  278sortDeref(P, P).
  279
  280
  281all_different_bindings([]):- !.
  282all_different_bindings([_]):- !.
  283all_different_bindings([X, Y]):- !, dif(X, Y).
  284all_different_bindings([X, Y, Z]):- !, dif(X, Y), dif(X, Z), dif(Z, Y).
  285all_different_bindings([X|Text]):- maplist(dif(X), Text), all_different_bindings(Text).
  286
  287wrapper_funct_sortin(F):- arg(_, v(~, post, pre), F).
  288wrapper_funct_correction(F):- arg(_, v(~, post, normally, pre), F).
  289
  290correct_normals(Nil, Nil):- Nil==[], !.
  291correct_normals(EOL, []):- EOL==end_of_list, !.
  292correct_normals(UNormals, Normals):- \+ compound(UNormals), !, [UNormals]=Normals.
  293correct_normals(~(PreU), Normals):- compound(PreU), PreU=pre(U), !, correct_normals(pre(~(U)), Normals).
  294correct_normals((U, UU), Normals):- !, correct_normals(U, UC), correct_normals(UU, UUC), !, append(UC, UUC, Normals).
  295correct_normals([U|UU], Normals):- !, correct_normals(U, UC), correct_normals(UU, UUC), !, append(UC, UUC, Normals).
  296correct_normals(P, Normals):- P=..[F, A1, A2|List], wrapper_funct_correction(F),
  297  P1=..[F, A1], P2=..[F, A2|List], !,
  298  correct_normals([P1|P2], Normals).
  299correct_normals(Normal, [Normal]).
  300
  301
  302frcmp(Cmp, P1, P2):- (\+ compound(P1) ; \+ compound(P2)), !, compare(Cmp, P1, P2).
  303frcmp(Cmp, P1, P2):- N=1, (arg(N, P1, A);arg(N, P2, A)), is_list(A), !, compare(Cmp, P1, P2).
  304frcmp(Cmp, P2, P1):- sortDeref(P1, PP1)->P1\=@=PP1, !, frcmp(Cmp, P2, PP1).
  305frcmp(Cmp, P1, P2):- sortDeref(P1, PP1)->P1\=@=PP1, !, frcmp(Cmp, PP1, P2).
  306frcmp(Cmp, P1, P2):- N=1, arg(N, P1, F1), arg(N, P2, F2), F1==F2, !, compare(Cmp, P1, P2).
  307frcmp(Cmp, P1, P2):- safe_functor(P1, F1, _), safe_functor(P2, F2, _), F1\==F2, compare(Cmp, F1, F2), Cmp \= (=), !.
  308frcmp(Cmp, P1, P2):- arg(N, P1, F1), arg(N, P2, F2), frcmp(Cmp, F1, F2), Cmp \= (=), !.
  309frcmp(Cmp, P1, P2):- compare(Cmp, P1, P2).
  310%reframed_call( Pred, Doer, [give, Object, to, Recipient], give(Doer, Object, Recipient), _Mem):- !.
  311
  312
  313
  314sUbst_each(A, [NV|List], D) :-
  315    (   NV=..[_, N, V]
  316    ->  true
  317    ;   NV=..[N, V]
  318    ),
  319    !,
  320    sUbst(A, N, V, M),
  321    sUbst_each(M, List, D).
  322sUbst_each(A, _, A).
  323
  324
  325
  326
  327sUbst(A, B, C, D) :-
  328    notrace(nd_sUbst(A, B, C, D0)),
  329    on_x_debug(D=D0), !.
  330
  331
  332
  333
  334nd_sUbst(Var, VarS, SUB, SUB) :-
  335    Var==VarS,
  336    !.
  337nd_sUbst(Var, _, _, Var) :-
  338    (\+ compound(Var); Var = '$VAR'(_)),
  339    !.
  340
  341nd_sUbst([H|P], X, Sk, [H1|P1]) :- !, 
  342    nd_sUbst(H, X, Sk, H1), 
  343    nd_sUbst(P, X, Sk, P1).
  344
  345nd_sUbst(P, X, Sk, P1) :-
  346    compound_name_arguments(P, Fc, Args),
  347    nd_sUbst2(X, Sk, Fc, 0, [Fc|Args], [RFc|RArgs]),
  348    compound_name_arguments(P1, RFc, RArgs).
  349
  350nd_sUbst2(_, _, _, _, [], []):-!.
  351nd_sUbst2(X, Sk, Fc, N, [A|Args], [R|RArgs]):-
  352  subst_arg(X, Sk, Fc, N, A, R),
  353  N1 is N + 1,
  354  nd_sUbst2(X, Sk, Fc, N1, Args, RArgs).
  355
  356subst_arg(X, Sk, Fc, N, A, R):- \+ skipped_replace(Fc,N), nd_sUbst(A, X, Sk, R).
  357subst_arg(_,  _,  _, _, A, A).
  358
  359skipped_replace('$VAR',_).
  360skipped_replace('frame_var',1).
  361skipped_replace('cg_name',2).
  362skipped_replace('cg_values',2).
  363
  364:- fixup_exports.