14:- module(logicmoo_util_bb_env, [
15 abolish_and_make_static/2,
16 add_push_prefix_arg/4,
17 18 19 clause_to_hb/3,
20 clause_to_hb0/3,
21 decl_env_mpred/2,
22 decl_env_mpred_dom/2,
23 decl_env_mpred_fa/4,
24 decl_env_mpred_real/4,
25 decl_env_mpred_task/2,
26 do_prefix_arg/4,
27 env_1_info/2,
28 env_assert/1,
29 env_asserta/1,
30 (env_call)/1,
31 env_clear/1,
32 env_consult/1,
33 env_get/1,
34 env_info/1,
35 env_info/2,
36 env_learn_pred/2,
37 env_meta_term/1,
38 env_mpred_op/1,
39 env_mpred_op/2,
40 env_mpred_op/3,
41 env_mpred_op_1/3,
42 env_predinfo/2,
43 env_push_args/4,
44 env_push_argsA/4,
45 env_recorded/2,
46 env_retract/1,
47 env_retractall/1,
48 env_set/1,
49 env_shadow/2,
50 env_source_file/1,
51 env_term_expansion/2,
52 get_env_ctx/1,
53 get_env_expected_ctx/1,
54 get_env_source_ctx/2,
55 get_mp_arity/2,
56 get_mpred_stubType/3,
57 harvest_preds/2,
58 hb_to_clause_env/3,
59 hb_to_clause_env0/3,
60 in_dyn/2,
61 in_dyn_pred/2,
62 inside_file_bb/1,
63 lg_op2/3,
64 ppi/1,
65 pred_1_info/4,
66 push_prefix_arg/4,
67 term_expansion_add_context/5
68]).
75:- kb_global(baseKB:mpred_prop/4). 76
77 :- meta_predicate 78 env_call(+),
79 env_consult(:),
80 env_mpred_op(1, :),
81 env_mpred_op(?, 1, :),
82 env_mpred_op_1(?, 1, :),
83 env_shadow(1, ?). 84
86:- (module_transparent env_consult/1, env_mpred_op/2, env_mpred_op/3, env_mpred_op_1/3, env_shadow/2). 90
91
92
93
94:- thread_local(t_l:push_env_ctx/0). 95:- dynamic(bb:'$sourcefile_info_env'/1). 96:- multifile(bb:'$sourcefile_info_env'/1). 97
98:-asserta((t_l:push_env_ctx)). 99
100:- meta_predicate(env_call(+)). 101
102:- dynamic(env_push_args/4). 103:- multifile(env_push_args/4). 104:- thread_local(t_l:db_spy/0). 105
106:- thread_local((canDoTermExp/0)). 107:- retractall(canDoTermExp). 108
109
111
113
114env_call(P):- call(ocl:P),ppi(P).
115env_assert(P):- call(assert,ocl:P),!.
116env_asserta(P):- call(asserta,ocl:P),!.
117env_retract(P):- call(retract,ocl:P).
118env_retractall(F/A):- functor(P,F,A),!,retractall(ocl:P),!.
119env_retractall(P):- call(retractall,ocl:P),!.
120
129
130env_clear(baseKB(Dom)):-nonvar(Dom),!,env_clear(Dom).
131env_clear(Dom):- forall(baseKB:mpred_prop(M,F,A,Dom),env_mpred_op(retractall(M:F/A))).
132env_mpred_op(OP_P):- OP_P=..[OP,P],env_mpred_op(OP,P).
133
134:- module_transparent(env_mpred_op/2). 135:- meta_predicate env_mpred_op(1,:). 136env_mpred_op(OP,P):- var(OP),!,P.
139env_mpred_op(OP,F/A):-integer(A),atom(F),!,functor(P,F,A),!,env_mpred_op(OP,P).
140env_mpred_op(OP,P):- t_l:push_env_ctx, do_prefix_arg(P, ZZ, PP, _Type),P\==PP,!,get_env_ctx(ZZ),call(OP,cl:PP).
141env_mpred_op(OP,P):- functor_h(P,F,A),must(get_mpred_stubType(F,A,ENV)),!,env_mpred_op(ENV,OP,P).
142env_mpred_op(OP,P):- append_term(OP,P,CALL),current_predicate(_,CALL),!,show_call(why,cl:CALL).
143env_mpred_op(OP,P):- dtrace,trace_or_throw(unk_env_mpred_op(OP,P)).
144
145env_shadow(OP,P):-baseKB:call(OP,P).
146
147:- dynamic( in_dyn/2). 148in_dyn(_DB,Call):- var(Call),!,get_mp_arity(F,A),functor(Call,F,A),( predicate_property(Call,_) -> loop_check(Call)).
149in_dyn(_DB,Call):- functor(Call,F,A), get_mp_arity(F,A), predicate_property(Call,_), !, loop_check(Call).
150in_dyn_pred(_DB,Call):- var(Call),!,get_mp_arity(F,A),functor(Call,F,A),( predicate_property(Call,_) -> loop_check(Call)).
151in_dyn_pred(_DB,Call):- functor(Call,F,A), get_mp_arity(F,A), predicate_property(Call,_), !, loop_check(Call).
152
153:- dynamic(get_mp_arity/2). 154
155get_mp_arity(F,A):- defaultAssertMt(M),if_defined(M:arity(F,A)).
156get_mp_arity(F,A):- get_current_default_tbox(M),if_defined(M:arity(F,A)).
157get_mp_arity(F,A):- arity_no_bc(F,A).
158
160
161get_mpred_stubType(_,_,dyn):-!.
162get_mpred_stubType(F,A,StubOut):-
163 clause_b(mpred_prop(_M,F,A,stubType(Stub))),!,must(StubIn=Stub),
164 165 nop(StubIn==dyn->true;dmsg(get_mpred_stubType(F,A,StubIn))),
166 StubOut=dyn.
167
168get_mpred_stubType(F,A,dyn):- clause_b(mpred_prop(_M,F,A,dyn)).
169get_mpred_stubType(_,_,dyn).
170
171:- ain(isa_kb:box_prop(l)). 172:- ain(isa_kb:box_prop(g)). 173:- ain(isa_kb:box_prop(dyn)). 174:- thread_initialization(nb_setval(disabled_env_learn_pred,false)). 175
176:- thread_local(t_l:env_ctx/2). 177
178:- export(decl_env_mpred/2). 180
181decl_env_mpred(_,[]):-!.
182decl_env_mpred([],_):-!.
183decl_env_mpred(Props,[H|T]):-!,decl_env_mpred(Props,H),decl_env_mpred(Props,T).
184decl_env_mpred(Props,(H,T)):-!,decl_env_mpred(Props,H),decl_env_mpred(Props,T).
185
186
187decl_env_mpred([H],Pred):-!,decl_env_mpred(H,Pred).
188decl_env_mpred([H|T],Pred):-!,decl_env_mpred(H,Pred),decl_env_mpred(T,Pred).
189decl_env_mpred((H,T),Pred):-!,decl_env_mpred(H,Pred),decl_env_mpred(T,Pred).
190
191decl_env_mpred(baseKB(KB),_):- ain(isa_abox(KB)),fail.
192decl_env_mpred(stubType(dyn),Pred):-!, decl_env_mpred(dyn,Pred).
193
194decl_env_mpred(CMPD,Pred):- fail, compound(CMPD),CMPD=..[_|CMPDL],
195 decl_env_mpred(CMPDL,Pred),
196 get_functor(Pred,F,A),
197 decl_env_mpred_fa(CMPD,Pred,F,A),!.
198
199decl_env_mpred(Prop,Pred):- get_functor(Pred,F,A),
200 decl_env_mpred_fa(Prop,Pred,F,A).
201
202decl_env_mpred_dom(Props,Preds):-
203 must(locally(t_l:env_ctx(dom,_CurrentDomain),
204 decl_env_mpred([dom|Props],Preds))).
205decl_env_mpred_task(Props,Preds):-
206 must(locally(t_l:env_ctx(task,_CurrentTask),
207 decl_env_mpred([task|Props],Preds))).
208
209
211abolish_and_make_static(F,A):-
212 ignore(baseKB:mpred_prop(M,F,A,_)),
213 ignore(baseKB:current_predicate(M:F/A)),
214
215 must_det_l((
216 retractall(get_mp_arity(F,A)),
217 retractall(arity(F,A)),
218 retractall(baseKB:mpred_prop(M,F,A,_)),
219 functor(H,F,A),
220 abolish(M:F,A),
221 asserta((H:-trace_or_throw(H))),
222 M:compile_predicates([F/A]),lock_predicate(H))).
223
224decl_env_mpred_fa(Prop,_Pred,F,A):- t_l:push_env_ctx,
225 t_l:env_ctx(Type,Prefix),A1 is A+1,
226 must_det_l((functor(Pred1,F,A1),functor(Pred,F,A),
227 must(add_push_prefix_arg(Pred,Type,Prefix,Pred1)),
228 abolish_and_make_static(F,A),
229 must((decl_env_mpred_real(Prop,Pred1,F,A1),
230 if_defined(arity(F,AA)),
231 must(arity(F,A1)==arity(F,AA)))))),!.
232decl_env_mpred_fa(Prop,Pred,F,A):-
233 decl_env_mpred_real(Prop,Pred,F,A).
234
235decl_env_mpred_real(Prop,Pred,F,A):-
236 ignore(baseKB:mpred_prop(M,F,A,_)),
237 ignore(M=ocl),
238 (Prop==task->(thread_local(cl:F/A));true),
239 (Prop==dyn->(dynamic(cl:F/A));true),
240 (Prop==cache->'$set_pattr'(ocl:Pred, pred, (volatile));true),
241 (Prop==dom->(multifile(cl:F/A));true),
242 baseKB:export(cl:F/A),
243 if_defined(decl_mpred(Pred,Prop),ain(baseKB:box_prop(F,Prop))),
244 ain(isa_kb:box_prop(Prop)),
245 ain(get_mp_arity(F,A)),
246 ain(arity(F,A)),!,
247 248 ain(baseKB:mpred_prop(M,F,A,Prop)).
249
250
251env_learn_pred(_,_):-nb_getval(disabled_env_learn_pred,true),!.
252env_learn_pred(ENV,P):-baseKB:decl_env_mpred(ENV,P).
253
254env_recorded(call,Val) :- recorded(Val,Val).
255env_recorded(assert, Val) :- recordz(Val,Val).
256env_recorded(asserta, Val) :- recorda(Val,Val).
257env_recorded(retract, Val) :- recorded(Val,Val,Ref), erase_safe(recorded(Val,Val,Ref),Ref).
258env_recorded(retractall, Val) :- foreach( recorded(Val,Val,Ref), erase_safe(recorded(Val,Val,Ref),Ref) ).
259
260lg_op2(rec_db,OP,env_recorded(OP)).
261lg_op2(g,OP,OP).
262
263lg_op2(_,OP,OP).
264
265:- meta_predicate env_mpred_op(?,1,:). 266:- meta_predicate env_mpred_op_1(?,1,:). 267:- meta_predicate env_shadow(1,?). 268
269env_mpred_op(_,_,[]):-!.
270env_mpred_op(ENV,OP,F/A):- 271 var(A),!, forall(clause_b(mpred_prop(_M,F,A,ENV)),((functor(P,F,A),env_mpred_op(ENV,OP,P)))).
272env_mpred_op(ENV,retractall,F/A):-functor(P,F,A),!,env_mpred_op(ENV,retractall,P).
277env_mpred_op(ENV,OP,P):- functor_h(P,F,A), (((get_mpred_stubType(F,A,LG2),LG2\==ENV) -> env_mpred_op_1(LG2,OP,P) ; env_mpred_op_1(ENV,OP,P) )).
278
279
280env_mpred_op_1(dyn,OP,P):- !,call(OP,cl:P).
281env_mpred_op_1(ENV,OP,(A,B)):-!, env_mpred_op(OP,A), env_mpred_op(ENV,OP,B).
282env_mpred_op_1(ENV,OP,[A|B]):-!, env_mpred_op(ENV,OP,A), env_mpred_op(ENV,OP,B).
283
284env_mpred_op_1(in_dyn(DB),OP,P):- !, call(OP,in_dyn(DB,P)).
285env_mpred_op_1(in_pred(DB),OP,P):-!, DBPRED=..[DB,P], call(OP,DBPRED).
286env_mpred_op_1(with_pred(Pred),OP,P):-!, call(Pred,OP,P).
288env_mpred_op_1(ENV,OP,P):- lg_op2(ENV,OP,OP2),!,call(OP2,P).
290env_mpred_op_1(stubType(ENV),OP,P):-!,env_mpred_op(ENV,OP,P).
292env_mpred_op_1(_,OP,P):-!,env_mpred_op_1(in_dyn(db),OP,P).
293env_mpred_op_1(_,_,_):-dtrace,fail.
294env_mpred_op_1(l,OP,P):-!,call(OP,cl:P).
295env_mpred_op_1(g,OP,P):-!,call(OP,cl:P).
296env_mpred_op_1(l,OP,P):-!,env_mpred_op_1(dyn,OP,P).
297env_mpred_op_1(l,OP,P):-!,env_mpred_op_1(in_dyn(db),OP,P).
298env_mpred_op_1(l,OP,P):-!,env_mpred_op_1(rec_db,OP,P).
299env_mpred_op_1(g,asserta,P):-retractall(cl:P),asserta(cl:P).
300env_mpred_op_1(g,assert,P):-ain(P).
301env_mpred_op_1(g,retract,P):-env_mpred_op_1(g,call,P),retract(cl:P).
302env_mpred_op_1(g,retractall,P):-foreach(env_mpred_op_1(g,call,P),retractall(P)).
303env_mpred_op_1(ENV,OP,P):-env_learn_pred(ENV,P),lg_op2(ENV,OP,OP2),!,call(OP2,P).
304env_mpred_op_1(_,OP,P):-call(OP,P).
305
308ppi(_).
309
310
311env_info(O):- forall(env_info(O,Info),portray_clause(env_info(O):-Info)).
312
313env_info(Type,Infos):- isa_kb:box_prop(Type),atom(Type),!,findall(Info,env_1_info(Type,Info),Infos),!.
314env_info(Pred,Infos):- (nonvar(Pred)-> env_predinfo(Pred,Infos) ; (get_mp_arity(F,A),Pred=F/A,env_predinfo(Pred,Infos))),!.
315
316
317harvest_preds(Type,Functors):-
318 findall(functor(P,F,A),((get_mp_arity(F,A),(clause_b(mpred_prop(_M,F,A,Type));Type=F),functor(P,F,A))),Functors).
319
320env_1_info(Type,[predcount(NC)|Infos]):-
321 gensym(env_1_info,Sym),flag(Sym,_,0),
322 harvest_preds(Type,PFAs),
323 findall(F/A - PredInf,
324 (member(functor(P,F,A),PFAs),
325 predicate_property(P,number_of_clauses(NC)),
326 env_predinfo(P,PredInf),
327 flag(Sym,X,X+NC)),
328 Infos),flag(Sym,NC,0).
329
330env_predinfo(PIn,Infos):- functor_h(PIn,F,A),get_mp_arity(F,A),functor(P,F,A),findall(Info,pred_1_info(P,F,A,Info),Infos).
331
332pred_1_info(P,_,_,Info):-
333 member(Info:Prop,[count(NC):number_of_clauses(NC),mf:multifile,dyn:dynamic,vol:volitile,local:local]),predicate_property(P,Prop).
334pred_1_info(_,F,A,Info):- clause_b(mpred_prop(_M,F,A,Info)).
335pred_1_info(_,F,A,F/A).
336
337
338:- meta_predicate(env_consult(:)). 339env_consult(M:File):- \+ exists_file(File),!,forall(filematch(File,FM),env_consult(M:FM)).
340env_consult(M:File):- ain(env_source_file(File)), locally(((M:term_expansion(A,B):- t_l:push_env_ctx, env_term_expansion(A,B))),M:consult(File)).
341
342
343env_set(Call):-Call=..[P,V],!,hooked_gvar_put(P,V).
344env_get(Call):-Call=..[P,V],!,hooked_gvar_get(P,V).
345
346
347env_meta_term(t(env_call,env_assert,env_asserta,env_retract,env_retractall)).
348
350
351env_push_argsA(Pred, Type,Prefix,Pred1 ):-t_l:push_env_ctx, env_push_args(Pred, Type,Prefix,Pred1 ).
352
353
354
355do_prefix_arg(Pred,Prefix,Pred1 ,Type ):- do_prefix_arg0(Pred,Prefix,Pred1 ,Type ),!.
356do_prefix_arg(M:Pred,Prefix,M:Pred1 ,Type ):- do_prefix_arg0(Pred,Prefix,Pred1 ,Type ),!.
357
358do_prefix_arg0(Pred,Prefix,Pred ,Type ) :-env_push_argsA(_, Type,Prefix,Pred ),!.
359do_prefix_arg0(Pred,Prefix,Pred1 ,Type ) :-env_push_argsA(Pred, Type,Prefix,Pred1 ),!.
361
362
363push_prefix_arg(Pred,Type,Prefix,Pred ):-env_push_argsA(_,Type,Prefix,Pred),!,must(compound(Pred)).
364push_prefix_arg(Pred,Type,Prefix,Pred1):-env_push_argsA(Pred,Type,Prefix,Pred1),!.
365
366add_push_prefix_arg(Pred,Type,Prefix,Pred1):- must_det(add_push_prefix_arg0(Pred,Type,Prefix,OUT)),must(Pred1=OUT).
367add_push_prefix_arg0((F/A),Type,Prefix,Pred1):- !, sanity((atom(F),integer(A))),functor(Pred,F,A),
368 add_push_prefix_arg0(Pred,Type,Prefix,Pred1).
369add_push_prefix_arg0(Pred,Type,Prefix,Pred1):- sanity(atom(Type)),Pred=..[F|ARGS],Pred1=..[F,Prefix|ARGS],
370 ain(env_push_args(Pred,Type,Prefix,Pred1)),!.
371
372
373term_expansion_add_context(_NeedIt,_Ctx,_,B,B):- var(B),!.
374term_expansion_add_context( NeedIt, Ctx,Outter,B,BB):- Outter \== (/),
375 do_prefix_arg(B,Ctx,BB,_Type),!,ignore(NeedIt=Outter).
376
377term_expansion_add_context(_NeedIt,_Ctx,_,B,B):- \+compound(B),!.
378term_expansion_add_context(_NeedIt,_Ctx,_,DECL,DECLN):-
379 DECL =..[DF,(F/A)],number(A),atom(F),functor(H,F,A),
380 term_expansion_add_context(_Dont,_Ctx2, decl ,H,HH),
381 DECLN =..[DF,(F/B)],functor(HH,F,B).
382term_expansion_add_context( NeedIt, Ctx,_,B,BB):- B=..[F|A], must_maplist(term_expansion_add_context(NeedIt,Ctx,F),A,AA),BB=..[F|AA],!.
383
384:- dynamic(env_source_file/1). 385
386hb_to_clause_env(H,B,HB):- hb_to_clause_env0(H,B,HB0),!,HB=HB0.
387hb_to_clause_env0(H,T,H):- T==true.
388hb_to_clause_env0(T,B,(:-B)):- T==true.
389hb_to_clause_env0(H,B,(H:-B)).
390
391
392clause_to_hb(HB,H,B):-clause_to_hb0(HB,H0,B0),!,H=H0,B=B0.
393clause_to_hb0((C:-T),H,B):- T==true,clause_to_hb0(C,H,B).
394clause_to_hb0((H:-B),H,B).
395clause_to_hb0((:-B),true,B).
396clause_to_hb0((H),H,true).
397
398:- export(env_term_expansion/2). 399env_term_expansion(HB,HB):- \+ compound(HB),!.
400env_term_expansion(HB,HB):- is_ftVar(HB),!.
401env_term_expansion(HB,OUT):-
402 403 ((
404 405 ((
406 clause_to_hb(HB,H,B),
407 term_expansion_add_context(BNeedIt,Ctx,(:-),B,BB),
408 term_expansion_add_context(HNeedIt,Ctx,(:-),H,HH),
409 ((var(BNeedIt),functor(HH,F,A),\+functor(H,F,A)) -> ((get_env_ctx(Ctx),nonvar(Ctx))) ; true),
410 (((nonvar(HNeedIt);nonvar(BNeedIt)),var(Ctx)) -> BBB = (get_env_ctx(Ctx),BB) ; BBB = BB))))),
411 (BBB\==B ; H\==HH),
412 must_det_l((
413 dmsg((old(H):-B)),dmsg((new(HH):-BBB)),
414 hb_to_clause_env(HH,BBB,OUT))),!.
415
416env_term_expansion(HB,(H:-B)):- HB\=(:-_),
417 end_of_file\==HB,
418 clause_to_hb(HB,H,B),
419 _ALT = bb:'$sourcefile_info_env'(OUT),
420 must(ain((H:-B))),
421 hb_to_clause_env(H,B,OUT),!.
422
423
424get_env_expected_ctx(Current):-
425 (prolog_load_context(source,File) -> Current = loading(File) ; (env_source_file(_) -> Current = memory ; Current = bb )).
426
427get_env_source_ctx(A,Active):-
428 clause(domain_name(A),true,Ref),
429 (clause_property(Ref,file(From)) -> (env_source_file(From) -> Active = loaded(From) ; Active = loading(From)) ; Active = memory).
430
431get_env_ctx(A):- hooked_gvar_get(domain_name,A),!.
432get_env_ctx(A):-
433 get_env_expected_ctx(Current),
434 get_env_source_ctx(A, Active),
435 ( Current=Active -> true ; fail).
436get_env_ctx(_ChameleonWorld).
438
439:- add_push_prefix_arg(get_tasks/3,dom,_,_). 440:- add_push_prefix_arg(domain_name/1,dom,_,_). 441
442inside_file_bb(ocl):- loading_file(File),!,once(file_name_extension(_,ocl,File);env_source_file(File)),!.
443
451
452:- env_term_expansion((
453 mpred_undo(Why,nt(Head,Condition,Body)) :-
454 455 !,
456 (retract_i(nt(Head,Condition,Body))
457 -> mpred_unfwc(nt(Head,Condition,Body))
458 ; pfc_trace_msg("for ~p:\nTrigger not found to retract: ~p",[Why,nt(Head,Condition,Body)]))),OOO),
459 wdmsg(OOO). 460
491
492:- fixup_exports.
Utility LOGICMOO_UTIL_BB_ENV
This module sets up the blackboard environment.