2
3:- op(1001,xfy,('...')). 4:- op(1200,xfy,('--->')). 5:- op(500,fx,+). 6:- op(500,fx,-). 7
8:- ensure_loaded(library(logicmoo/redo_locally)). 9
11
12:-thread_local tlxgproc:current_xg_module/1. 13:-thread_local tlxgproc:current_xg_filename/1. 14:-dynamic user:current_xg_pred/4. 15:-multifile user:current_xg_pred/4. 16
17
18abolish_xg(Prop):- ignore(tlxgproc:current_xg_module(M)),
19 ignore((((user:current_xg_pred(M,F,N,Props),member(Prop,Props),member(Prop,Props),
20 ignore((memberchk(xg_pred=P,Props),dmsg(abolising(current_xg_pred(M,F,N,Props))),
21 predicate_property(P,number_of_clauses(NC)),flag(xg_assertions,A,A-NC))),
22 abolish(F,N),retractall(user:current_xg_pred(M,F,N,_)))),fail)).
23
24new_pred(P):- must(tlxgproc:current_xg_module(M)),new_pred(M,P).
25new_pred(M,P0):- functor(P0,F,A),functor(P,F,A),new_pred(M,P,F,A),!.
26
35
36new_pred(M,_,F,A):- user:current_xg_pred(M,F,A,_),!.
37new_pred(_,P,_,_):- recorded(P,'xg.pred',_), !.
38new_pred(M,P,F,A) :-
39 share_mp(M:F/A),
40 findall(K=V,(((K=xg_source,tlxgproc:current_xg_filename(V));(prolog_load_context(K,V),not(member(K,[stream,directory,variable_names])));((seeing(S),member(G,[(K=file,P=file_name(V)),(K=position,P=position(V))]),G,stream_property(S,P))))),Props),
41 asserta_if_new(user:current_xg_pred(M,F,A,[xg_source=F,xg_ctx=M,xg_fa=(F/A),xg_pred=P|Props])),
42 recordz(P,'xg.pred',_),
43 recordz('xg.pred',P,_).
44
45is_file_ext(Ext):-prolog_load_context(file,F),file_name_extension(_,Ext,F).
46:-thread_local tlxgproc:do_xg_process_te/0. 47:-export(xg_process_te_clone/5). 48
49processing_xg :- is_file_ext(xg),!.
50processing_xg :- tlxgproc:do_xg_process_te,!.
51
52xg_process_te_clone(L,R,_Mode,P,Q):- expandlhs(L,S0,S,H0,H,P), expandrhs(R,S0,S,H0,H,Q). 53
54:-export(xg_process_te_clone/3). 55xg_process_te_clone((H ... T --> R),Mode,((P :- Q))) :- !, xg_process_te_clone((H ... T),R,Mode,P,Q).
56xg_process_te_clone((L --> R),Mode,((P :- Q))) :- !,xg_process_te_clone(L,R,Mode,P,Q).
57xg_process_te_clone((L ---> R),Mode,((P :- Q))) :- !,xg_process_te_clone(L,R,Mode,P,Q).
58
59chat80_term_expansion(In,Out):- compound(In),functor(In,'-->',_), fail,trace,fail, must(xg_process_te_clone(In,+,Out)).
60chat80_term_expansion((H ... T ---> R),((P :- Q))) :- must( xg_process_te_clone((H ... T),R,+,P,Q)).
61chat80_term_expansion((L ---> R), ((P :- Q))) :- must(xg_process_te_clone(L,R,+,P,Q)).
62
63
64chat80_term_expansion_now(( :- _) ,_ ):-!,fail.
65chat80_term_expansion_now(H,':-'(ain(O))):- fail,trace,fail, chat80_term_expansion(H,O),!.
66
67xgproc:term_expansion(H, O):- processing_xg->chat80_term_expansion_now(H,O).
68
77
78load_plus_xg_file(CM,F) :- fail,
79 locally(tlxgproc:current_xg_module(CM),
80 locally(tlxgproc:do_xg_process_te,CM:ensure_loaded_no_mpreds(F))),!.
82load_plus_xg_file(CM,F) :-
83 see(user),
84 locally(tlxgproc:current_xg_module(CM),consume0(F,+)),
85 seen.
86
88load_minus_xg_file(CM,F) :-
89 see(user),
90 locally(tlxgproc:current_xg_module(CM),consume0(F,-)),
91 seen.
92
94statistics_heap(H,0):- statistics(clauses,H).
95
96consume0(F,Mode) :-
97 seeing(Old),
98 statistics_heap(H0,Hf0),
99 absolute_file_name(F,FE),
100 see(FE),
101 tidy_consume(F,Mode),
102 ( (seeing(User)-> User=user), !; seen ),
103 see(Old),
104 statistics_heap(H,Hf),
105 U is H-Hf-H0+Hf0,
106 ttynl,
107 display('** Grammar from file '),
108 display(F),
109 display(' : '),
110 display(U),
111 display(' words **'),
112 ttynl, ttynl.
113
114tidy_consume(F,Mode) :-
115 consume(F,Mode),
116 fail.
117tidy_consume(_,_).
118
119consume(F,Mode) :-
120 flag(read_terms,_,0),
121 repeat,
122 read(X),
123 ( (X=end_of_file, !, xg_complete(F));
124 ((flag(read_terms,T,T+1),xg_process(X,Mode)),
125 fail )).
126
127xg_process((L ---> R),Mode) :- !,
128 expandlhs(L,S0,S,H0,H,P),
129 expandrhs(R,S0,S,H0,H,Q),
130 new_pred(P),
131 usurping(Mode,P),
132 xg_assertz((P :- Q)), !.
133xg_process(( :- G),_) :- !,
134 call(G).
135xg_process((P :- Q),Mode) :-
136 usurping(Mode,P),
137 new_pred(P),
138 xg_assertz((P :- Q)).
139xg_process(P,Mode) :-
140 usurping(Mode,P),
141 new_pred(P),
142 xg_assertz(P).
143
144xg_assertz(P):- flag(xg_assertions,A,A+1),must((tlxgproc:current_xg_module(M),nop(dbug(M:xg_assertz(P))),M:assertz(P))),!.
145
146xg_erase_safe(_,H):- erase(H).
147
148xg_complete(_F) :-
149 recorded('xg.usurped',P,R0), xg_erase_safe(recorded('xg.usurped',P,R0),R0),
150 recorded(P,'xg.usurped',R1), xg_erase_safe(recorded(P,'xg.usurped',R1),R1),
151 fail.
152xg_complete(F):- flag(read_terms,T,T),dmsg(info(read(T,F))),nl,nl.
153
154usurping(+,_) :- !.
155usurping(-,P) :-
156 recorded(P,'xg.usurped',_), !.
157usurping(-,P) :-
158 functor(P,F,N),
159 functor(Q,F,N),
160 retractrules(Q),
161 recordz(Q,'xg.usurped',_),
162 recordz('xg.usurped',Q,_).
163
164retractrules(Q) :-
165 clause(Q,B),
166 retractrule(Q,B),
167 fail.
168retractrules(_).
169
170retractrule(_,virtual(_,_,_)) :- !.
171retractrule(Q,B) :- retract((Q :- B)), !.
172
173
175
176expandlhs(T,S0,S,H0,H1,Q) :-
177 xg_flatten0(T,[P|L],[]),
178 front(L,H1,H),
179 tag(P,S0,S,H0,H,Q).
180
181xg_flatten0(X,L0,L) :- nonvar(X),!,
182 xg_flatten(X,L0,L).
183xg_flatten0(_,_,_) :-
184 ttynl,
185 display('! Variable as a non-terminal in the lhs of a grammar rule'),
186 ttynl,
187 fail.
188
189xg_flatten((X...Y),L0,L) :- !,
190 xg_flatten0(X,L0,[gap|L1]),
191 xg_flatten0(Y,L1,L).
192xg_flatten((X,Y),L0,L) :- !,
193 xg_flatten0(X,L0,[nogap|L1]),
194 xg_flatten0(Y,L1,L).
195xg_flatten(X,[X|L],L).
196
197front([],H,H).
198front([K,X|L],H0,H) :-
199 case(X,K,H1,H),
200 front(L,H0,H1).
201
202case([T|Ts],K,H0,x(K,terminal,T,H)) :- !,
203 unwind(Ts,H0,H).
204case(Nt,K,H,x(K,nonterminal,Nt,H)) :- virtualrule(Nt).
205
206
207virtualrule(X) :-
208 functor(X,F,N),
209 functor(Y,F,N),
210 tag(Y,S,S,Hx,Hy,P),
211 ( clause(P,virtual(_,_,_)), !;
212 new_pred(P),
213 asserta((P :- virtual(Y,Hx,Hy))) ).
214
215expandrhs(X,S0,S,H0,H,Y) :- var(X),!,
216 tag(X,S0,S,H0,H,Y).
217expandrhs((X1,X2),S0,S,H0,H,Y) :- !,
218 expandrhs(X1,S0,S1,H0,H1,Y1),
219 expandrhs(X2,S1,S,H1,H,Y2),
220 and(Y1,Y2,Y).
221expandrhs((X1;X2),S0,S,H0,H,(Y1;Y2)) :- !,
222 expandor(X1,S0,S,H0,H,Y1),
223 expandor(X2,S0,S,H0,H,Y2).
224expandrhs({X},S,S,H,H,X) :- !.
225expandrhs(L,S0,S,H0,H,G) :- islist(L), !,
226 expandlist(L,S0,S,H0,H,G).
227expandrhs(X,S0,S,H0,H,Y) :-
228 tag(X,S0,S,H0,H,Y).
229
230expandor(X,S0,S,H0,H,Y) :-
231 expandrhs(X,S0a,S,H0a,H,Ya),
232 ( S\==S0a, !, S0=S0a, Yb=Ya; and(S0=S0a,Ya,Yb) ),
233 ( H\==H0a, !, H0=H0a, Y=Yb; and(H0=H0a,Yb,Y) ).
234
235expandlist([],S,S,H,H,true).
236expandlist([X],S0,S,H0,H,terminal(X,S0,S,H0,H) ) :- !.
237expandlist([X|L],S0,S,H0,H,(terminal(X,S0,S1,H0,H1),Y)) :-
238 expandlist(L,S1,S,H1,H,Y).
239
240tag(P,A1,A2,A3,A4,QQ) :- var(P),!,
241 QQ = phraseXG(P,A1,A2,A3,A4).
242
243tag(P,A1,A2,A3,A4,Q) :-
244 P=..[F|Args0],
245 conc_gx(Args0,[A1,A2,A3,A4],Args),
246 Q=..[F|Args].
247
248and(true,P,P) :- !.
249and(P,true,P) :- !.
250and(P,Q,(P,Q)).
251
252islist([_|_]).
253islist([]).
254
255unwind([],H,H) :- !.
256unwind([T|Ts],H0,x(nogap,terminal,T,H)) :-
257 unwind(Ts,H0,H).
258
259
260conc_gx([],L,L) :- !.
261conc_gx([X|L1],L2,[X|L3]) :-
262 conc_gx(L1,L2,L3).
263
264
265xg_listing(File) :-
266 telling(Old),
267 tell(File),
268 list_clauses,
269 told,
270 tell(Old).
271
274compile_xg_clauses :- !.
277
278list_clauses :-
279 recorded('xg.pred',P,_),
280 functor(P,F,N),
281 listing(F/N),
282 nl,
283 fail.
284list_clauses.
285
286:-export(load_xg/0). 287
288load_xg:-
289 load_plus_xg_file(parser_chat80,'clone.xg'),
290 load_plus_xg_file(parser_chat80,'lex.xg'),
291 compile_xg_clauses.
292
293go_xg :- load_xg, xg_listing('newg.pl')