1:- module(assert_db_Local, [
2 goal_L_expansion/3, retractall_L_hp/2, retractall_L/2, retractall_L/1,
3 retract_L_hp/2, retract_L/2, retract_L/1, into_hp_L/2,
4 check_L/1, call_L/1, call_L/2, install_L/0, reset_L/0, last_cons/2,
5 assertz_L_hp/2, assertz_L/2, assertz_L/1, assert_L/2,
6 assert_L/1, asserta_L_hp/2, asserta_L/2, asserta_L/1, erase_L/2, clause_L/4,
7 ref_L/3, clause_L/3, erase_L/1, show_L/1,
8 listing_L/1, listing_L/0, was_dynamic_L/2,
9 make_dynamic_L/3, dynamic_L/1, install_L/0, disable_L/0, enable_L/0]). 10
11:- set_module(class(library)). 13
25
26:- module_transparent((
27 goal_L_expansion/3, retractall_L_hp/2, retractall_L/2, retractall_L/1,
28 retract_L_hp/2, retract_L/2, retract_L/1, into_hp_L/2,
29 check_L/1, call_L/1, call_L/2, install_L/0, reset_L/0, last_cons/2,
30 assertz_L_hp/2, assertz_L/2, assertz_L/1, assert_L/2,
31 assert_L/1, asserta_L_hp/2, asserta_L/2, asserta_L/1, erase_L/2, clause_L/4,
32 ref_L/3, clause_L/3, erase_L/1, show_L/1,
33 listing_L/1, listing_L/0, was_dynamic_L/2,
34 make_dynamic_L/3, dynamic_L/1, install_L/0, disable_L/0, enable_L/0)). 35
36:- dynamic(tmpldb:is_dynamic_L/1). 37:- volatile(tmpldb:is_dynamic_L/1). 38:- dynamic(tmpldb:is_file_L/1). 39:- volatile(tmpldb:is_file_L/1). 40
41disable_L:- set_prolog_flag(enable_L,false).
42enable_L:- set_prolog_flag(enable_L,true).
43install_L:- prolog_load_context(source, F), asserta(tmpldb:is_file_L(F)).
44
45dynamic_L((A, B)):- !, dynamic_L(A), dynamic_L(B).
46dynamic_L(F/A):- current_prolog_flag(enable_L,false), !, dynamic(F/A).
47dynamic_L(F/A):- functor(P, F, A), make_dynamic_L(P, F, A).
48
49make_dynamic_L(P, _, _):- tmpldb:is_dynamic_L(P), !.
51make_dynamic_L(P, F, A):- \+ current_prolog_flag(enable_L,true), predicate_property(P, defined), !, dynamic(F/A).
52make_dynamic_L(P, F, A):-
53 prolog_load_context(module, M),
54 assert(tmpldb:is_dynamic_L(P)), !,
55 assert((M:(P:- call_L(P)))),
56 compile_predicates([M:F/A]).
57
58
59was_dynamic_L(_, _):- current_prolog_flag(enable_L,false), !, fail.
60was_dynamic_L((P:-_), DB):- !, was_dynamic_L(P, DB).
61was_dynamic_L(P, DB):- tmpldb:is_dynamic_L(P), !, db_L(DB).
62was_dynamic_L(P, DB):- \+ predicate_property(P, defined),
63 functor(P, F, A), make_dynamic_L(P, F, A), !, db_L(DB), !.
64
65
66db_L(DB):- nb_current('$db', DB).
67
68
69listing_L:-
70 listing(tmpldb:_),
71 db_L(DB), listing_L(DB).
72
73listing_L(val(H, _, _)):-
74 format('~N~n', []),
75 maplist(show_L, H),
76 77 78 !.
79
80show_L(H:-B):- B==true, !, format('~NL: ~p.~n', [H]).
81show_L(H:-B):- !, format('~NL: ~p.~n', [H:-B]).
82show_L(HP):- HP=..[F,Body|ARGS], H=..[F|ARGS], show_L(H:-Body).
88asserta_L(P):- was_dynamic_L(P, DB), !, asserta_L(DB, P), check_L(DB).
89asserta_L(P):- asserta(P).
90asserta_L(DB, P) :- into_hp_L(P, HP), asserta_L_hp(DB, HP).
91
92assertz_L(P):- was_dynamic_L(P, DB), !, assertz_L(DB, P).
93assertz_L(P):- assertz(P).
94assertz_L(DB, P) :- into_hp_L(P, HP), assertz_L_hp(DB, HP), check_L(DB).
95
96assert_L(P):- assertz_L(P).
97assert_L(DB, H):- assertz_L(DB, H).
98
99erase_L(Ref):- compound(Ref), db_L(DB), !, erase_L(DB, Ref).
100erase_L(Ref):- erase(Ref).
101
102call_L(P):- was_dynamic_L(P, DB), !, call_L(DB, P).
103call_L(P):- call(P).
104
105call_L(val(List,_,_), P):- into_hp_L((P:-Body), HP), member(HP, List), call(Body).
106
107clause_L(H, B, Ref):- was_dynamic_L(H, DB), !, clause_L(DB, H, B, Ref).
108clause_L(H, B, Ref):- clause(H, B, Ref).
109
110clause_L(val(List, _, _), H, B, Ref):- H=..[F|HL], HP=..[F,B|HL], ref_L(List, HP, Ref).
111
112retract_L(P):- was_dynamic_L(P, DB), !, retract_L(DB, P).
113retract_L(P):- retract(P).
114retract_L(DB, P):- into_hp_L(P, HP), retract_L_hp(DB, HP).
115
116retractall_L(P):- was_dynamic_L(P, DB), !, retractall_L(DB, P).
117retractall_L(P):- retractall(P).
118retractall_L(DB, P0 :- _ ):- !, into_hp_L(P0:- _, P), retractall_L_hp(DB, P).
119retractall_L(DB, P0 ):- into_hp_L(P0:- _, P), retractall_L_hp(DB, P).
120
121reset_L:-
122 nb_setval('$db', val( [empty], _, _)),
123 db_L(DB),
124 arg(1, DB, End),
125 nb_linkarg(2, DB, End),
126 db_L(DB2),
127 check_real_L(DB2).
128
129
130
131ref_L(List, E, OneLeft):- List=[H|T], (H=E -> OneLeft=List ; ref_L(T, E, OneLeft)).
132
133into_hp_L((H:-B), HP):- H=..[F|HL], HP=..[F,B|HL].
134into_hp_L( H , HP):- H=..[F|HL], HP=..[F,true|HL].
135
136
137asserta_L_hp(DB, P):-
138 nb_setarg(3, DB, P), arg(3, DB, CopyP),
139 arg(1, DB, Front), nb_linkarg(1, DB, [CopyP|Front]).
140
141assertz_L_hp(DB, P):-
142 arg(2, DB, WasEnd),
143 assertz_L_hp_3(DB, WasEnd, P), !.
144
145assertz_L_hp_3( _, WasEnd, P):- arg(1, WasEnd, empty), !, nb_setarg(1, WasEnd, P).
146assertz_L_hp_3(DB, WasEnd, P):-
147 nb_setarg(3, DB, [P]), arg(3, DB, NewEnd),
148 149 nb_linkarg(2, WasEnd, NewEnd),
150 nb_linkarg(2, DB, NewEnd).
151
152retract_L_hp(DB, P):-
153 arg(1, DB, List),
154 notrace(ref_L(List, P, Ref)),
155 check_L(DB),
156 erase_L(DB, Ref).
157
158erase_L(DB, Ref):- Ref=[_|T], T= [H1|T1],
159 nb_linkarg(2, Ref, T1), nb_linkarg(1, Ref, H1),
160 (T1 \==[] -> true ; nb_linkarg(2, DB, Ref)), !, check_L(DB).
161erase_L(DB, Ref):- DB=val(_, Ref, _), nb_linkarg(1, Ref, empty), !, check_L(DB).
162
163check_L(_).
164check_real_L(val(List, End, _)):- notrace((last_cons(List, Last), (same_term(End, Last)->true;throw(not_same_term(End, Last))))).
165
166
167last_cons(In, Last):- In=[_|List],
168 ( ( \+ List=[_|_] ; var(List))
169 -> Last=In
170 ; last_cons(List, Last)).
171
172retractall_L_hp(DB, P):- \+ \+ retract_L_hp(DB, P), !, retractall_L_hp(DB, P).
173retractall_L_hp(_, _).
174
175goal_L_expansion(_, _, _):- prolog_load_context(source, F), \+ tmpldb:is_file_L(F), !, fail.
176goal_L_expansion(_, I, O):- do_goal_L_expansion(I, O).
177
178do_goal_L_expansion(dynamic(P), dynamic_L(P)).
179do_goal_L_expansion(assert(P), assert_L(P)).
180do_goal_L_expansion(assertz(P), assertz_L(P)).
181do_goal_L_expansion(asserta(P), asserta_L(P)).
182do_goal_L_expansion(retract(P), retract_L(P)).
183do_goal_L_expansion(retractall(P), retractall_L(P)).
184do_goal_L_expansion(erase(P), erase_L(P)).
185do_goal_L_expansion(clause(H, B), clause_L(H, B, _)).
186do_goal_L_expansion(clause(H, B, R), clause_L(H, B, R)).
187
188:- if(current_predicate(fixup_exports/0)). 189:- fixup_exports. 190:- else. 191module_L:-
192 prolog_load_context(source, S), prolog_load_context(module, M),
193 forall(source_file(M:H, S),
194 (functor(H, F, A),
195 format('~N ~q/~q, ~n', [F, A]))).
196:- endif. 197
198:- reset_L. 199
200:- system:import(goal_L_expansion/3). 201:- '$toplevel':import(goal_L_expansion/3). 202
203:- multifile(system:goal_expansion/2). 204:- module_transparent(system:goal_expansion/2). 205system:goal_expansion(I, O):-
206 prolog_load_context(module, M),
207 goal_L_expansion(M, I, O)