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).
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 ==[].
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
80
83
86
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)), !.
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 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 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
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 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 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.
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).
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.