1:- module( edcg, [
2 op(1200, xfx, '-->>'), 3 op(1200, xfx, '==>>'), 4 op( 990, fx, '?'), 5 edcg_import_sentinel/0
6]). 7
12:- if(\+ current_op(_, _, '=>')). 13:- op(1200, xfx, '=>'). 14:- endif. 15
16:- use_module(library(debug), [debug/3]). 17:- use_module(library(lists), [member/2]). 18
21:- multifile
22 acc_info/5,
23 acc_info/7,
24 pred_info/3,
25 pass_info/1,
26 pass_info/2. 27
28
30wants_edcg_expansion :-
31 prolog_load_context(module, Module),
32 Module \== edcg, 33 predicate_property(Module:edcg_import_sentinel, imported_from(edcg)).
34
36edcg_import_sentinel.
37
38
43
46
48user:term_expansion((H-->>B), _Layout1, Expansion, _Layout2) :-
49 edcg_term_expansion((H-->>B), Expansion).
50user:term_expansion((H,PB==>>B), _Layout1, Expansion, _Layout2) :-
51 edcg_term_expansion((H,PB==>>B), Expansion).
52user:term_expansion((H==>>B), _Layout1, Expansion, _Layout2) :-
53 edcg_term_expansion((H==>>B), Expansion).
54
55
58edcg_term_expansion((H-->>B), (TH:-TB)) :-
59 term_expansion_(H, B, TH, TB, NewAcc),
60 '_finish_acc'(NewAcc),
61 !.
62edcg_term_expansion((H,PB==>>B), (TH,Guards=>TB2)) :-
63 '_guard_expansion_'(PB, Guards),
64 term_expansion_(H, B, TH, TB, NewAcc),
65 '_finish_acc_ssu'(NewAcc, TB, TB2),
66 !.
67edcg_term_expansion((H==>>B), (TH=>TB2)) :-
68 term_expansion_(H, B, TH, TB, NewAcc),
69 '_finish_acc_ssu'(NewAcc, TB, TB2),
70 !.
71
74'_guard_expansion_'((?G0,G2), (G, GE2)) :- !,
75 '_guard_expansion_curly_'(G0, G),
76 '_guard_expansion_'(G2, GE2).
77'_guard_expansion_'(?G0, G) :- !,
78 '_guard_expansion_curly_'(G0, G).
79'_guard_expansion_'(G, _) :-
80 throw(error(type_error(guard,G),_)).
81
82'_guard_expansion_curly_'({G}, G) :- !.
83'_guard_expansion_curly_'(G, G).
84
85
86term_expansion_(H, B, TH, TB, NewAcc) :-
87 wants_edcg_expansion,
88 functor(H, Na, Ar),
89 '_has_hidden'(H, HList),
90 debug(edcg,'Expanding ~w',[H]),
91 '_new_goal'(H, HList, HArity, TH),
92 '_create_acc_pass'(HList, HArity, TH, Acc, Pass),
93 '_expand_goal'(B, TB, Na/Ar, HList, Acc, NewAcc, Pass).
94
96'_expand_goal'((G1,G2), (TG1,TG2), NaAr, HList, Acc, NewAcc, Pass) :-
97 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass),
98 '_expand_goal'(G2, TG2, NaAr, HList, MidAcc, NewAcc, Pass).
99'_expand_goal'((G1->G2;G3), (TG1->TG2;TG3), NaAr, HList, Acc, NewAcc, Pass) :-
100 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass),
101 '_expand_goal'(G2, MG2, NaAr, HList, MidAcc, Acc1, Pass),
102 '_expand_goal'(G3, MG3, NaAr, HList, Acc, Acc2, Pass),
103 '_merge_acc'(Acc, Acc1, MG2, TG2, Acc2, MG3, TG3, NewAcc).
104'_expand_goal'((G1*->G2;G3), (TG1*->TG2;TG3), NaAr, HList, Acc, NewAcc, Pass) :-
105 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass),
106 '_expand_goal'(G2, MG2, NaAr, HList, MidAcc, Acc1, Pass),
107 '_expand_goal'(G3, MG3, NaAr, HList, Acc, Acc2, Pass),
108 '_merge_acc'(Acc, Acc1, MG2, TG2, Acc2, MG3, TG3, NewAcc).
109'_expand_goal'((G1;G2), (TG1;TG2), NaAr, HList, Acc, NewAcc, Pass) :-
110 '_expand_goal'(G1, MG1, NaAr, HList, Acc, Acc1, Pass),
111 '_expand_goal'(G2, MG2, NaAr, HList, Acc, Acc2, Pass),
112 '_merge_acc'(Acc, Acc1, MG1, TG1, Acc2, MG2, TG2, NewAcc).
113'_expand_goal'((G1->G2), (TG1->TG2), NaAr, HList, Acc, NewAcc, Pass) :-
114 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass),
115 '_expand_goal'(G2, TG2, NaAr, HList, MidAcc, NewAcc, Pass).
116'_expand_goal'((G1*->G2), (TG1->TG2), NaAr, HList, Acc, NewAcc, Pass) :-
117 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass),
118 '_expand_goal'(G2, TG2, NaAr, HList, MidAcc, NewAcc, Pass).
119'_expand_goal'((\+G), (\+TG), NaAr, HList, Acc, Acc, Pass) :-
120 '_expand_goal'(G, TG, NaAr, HList, Acc, _TempAcc, Pass).
121'_expand_goal'({G}, G, _, _, Acc, Acc, _) :- !.
122'_expand_goal'(insert(X,Y), LeftA=X, _, _, Acc, NewAcc, _) :-
123 '_replace_acc'(dcg, LeftA, RightA, Y, RightA, Acc, NewAcc), !.
124'_expand_goal'(insert(X,Y):A, LeftA=X, _, _, Acc, NewAcc, _) :-
125 '_replace_acc'(A, LeftA, RightA, Y, RightA, Acc, NewAcc),
126 debug(edcg,'Expanding accumulator goal: ~w',[insert(X,Y):A]),
127 !.
129'_expand_goal'((G:A), TG, _, _HList, Acc, NewAcc, Pass) :-
130 \+'_list'(G),
131 '_has_hidden'(G, []), !,
132 '_make_list'(A, AList),
133 '_new_goal'(G, AList, GArity, TG),
134 '_use_acc_pass'(AList, GArity, TG, Acc, NewAcc, Pass).
137'_expand_goal'((G:A), TG, _, _HList, Acc, NewAcc, Pass) :-
138 \+'_list'(G),
139 '_has_hidden'(G, GList), GList\==[], !,
140 '_make_list'(A, L),
141 '_new_goal'(G, GList, GArity, TG),
142 '_replace_defaults'(GList, NGList, L),
143 '_use_acc_pass'(NGList, GArity, TG, Acc, NewAcc, Pass).
144'_expand_goal'((L:A), Joiner, NaAr, _, Acc, NewAcc, _) :-
145 '_list'(L), !,
146 '_joiner'(L, A, NaAr, Joiner, Acc, NewAcc).
147'_expand_goal'(L, Joiner, NaAr, _, Acc, NewAcc, _) :-
148 '_list'(L), !,
149 '_joiner'(L, dcg, NaAr, Joiner, Acc, NewAcc).
150'_expand_goal'((X/A), true, _, _, Acc, Acc, _) :-
151 atomic(A),
152 member(acc(A,X,_), Acc),
153 debug(edcg,'Expanding accumulator goal: ~w',[X/A]),
154 !.
155'_expand_goal'((X/A), true, _, _, Acc, Acc, Pass) :-
156 atomic(A),
157 member(pass(A,X), Pass),
158 debug(edcg,'Expanding passed argument goal: ~w',[X/A]),
159 !.
160'_expand_goal'((A/X), true, _, _, Acc, Acc, _) :-
161 atomic(A),
162 member(acc(A,_,X), Acc), !.
163'_expand_goal'((X/A/Y), true, _, _, Acc, Acc, _) :-
164 var(X), var(Y), atomic(A),
165 member(acc(A,X,Y), Acc), !.
166'_expand_goal'((X/Y), true, NaAr, _, Acc, Acc, _) :-
167 print_message(warning,missing_hidden_parameter(NaAr,X/Y)).
169'_expand_goal'(G, TG, _HList, _, Acc, NewAcc, Pass) :-
170 '_has_hidden'(G, GList), !,
171 '_new_goal'(G, GList, GArity, TG),
172 '_use_acc_pass'(GList, GArity, TG, Acc, NewAcc, Pass).
173
175
177
183'_create_acc_pass'([], _, _, [], []).
184'_create_acc_pass'([A|AList], Index, TGoal, [acc(A,LeftA,RightA)|Acc], Pass) :-
185 '_is_acc'(A), !,
186 Index1 is Index+1,
187 arg(Index1, TGoal, LeftA),
188 Index2 is Index+2,
189 arg(Index2, TGoal, RightA),
190 '_create_acc_pass'(AList, Index2, TGoal, Acc, Pass).
191'_create_acc_pass'([A|AList], Index, TGoal, Acc, [pass(A,Arg)|Pass]) :-
192 '_is_pass'(A), !,
193 Index1 is Index+1,
194 arg(Index1, TGoal, Arg),
195 '_create_acc_pass'(AList, Index1, TGoal, Acc, Pass).
196'_create_acc_pass'([A|_AList], _Index, _TGoal, _Acc, _Pass) :-
197 \+'_is_acc'(A),
198 \+'_is_pass'(A),
199 print_message(error,not_a_hidden_param(A)).
200
201
204'_use_acc_pass'([], _, _, Acc, Acc, _).
206'_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass) :-
207 '_replace_acc'(A, LeftA, RightA, MidA, RightA, Acc, MidAcc), !,
208 Index1 is Index+1,
209 arg(Index1, TGoal, LeftA),
210 Index2 is Index+2,
211 arg(Index2, TGoal, MidA),
212 '_use_acc_pass'(GList, Index2, TGoal, MidAcc, NewAcc, Pass).
214'_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass) :-
215 '_acc_info'(A, LStart, RStart), !,
216 Index1 is Index+1,
217 arg(Index1, TGoal, LStart),
218 Index2 is Index+2,
219 arg(Index2, TGoal, RStart),
220 '_use_acc_pass'(GList, Index2, TGoal, Acc, NewAcc, Pass).
222'_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass) :-
223 '_is_pass'(A),
224 member(pass(A,Arg), Pass), !,
225 Index1 is Index+1,
226 arg(Index1, TGoal, Arg),
227 '_use_acc_pass'(GList, Index1, TGoal, Acc, NewAcc, Pass).
229'_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass) :-
230 '_pass_info'(A, AStart), !,
231 Index1 is Index+1,
232 arg(Index1, TGoal, AStart),
233 '_use_acc_pass'(GList, Index1, TGoal, Acc, NewAcc, Pass).
235'_use_acc_pass'([A|_GList], _Index, _TGoal, Acc, Acc, _Pass) :-
236 print_message(error,not_a_hidden_param(A)).
237
241'_finish_acc'([]).
242'_finish_acc'([acc(_,Link,Link)|Acc]) :- '_finish_acc'(Acc).
243
244'_finish_acc_ssu'([], TB, TB).
245'_finish_acc_ssu'([acc(_,Link0,Link1)|Acc], TB0, TB) :-
246 '_finish_acc_ssu'(Acc, (Link0=Link1,TB0), TB).
247
250'_replace_acc'(A, L1, R1, L2, R2, Acc, NewAcc) :-
251 member(acc(A,L1,R1), Acc), !,
252 '_replace'(acc(A,_,_), acc(A,L2,R2), Acc, NewAcc).
253
255'_merge_acc'([], [], G1, G1, [], G2, G2, []) :- !.
256'_merge_acc'([acc(Acc,OL,R)|Accs], [acc(Acc,L1,R)|Accs1], G1, NG1,
257 [acc(Acc,L2,R)|Accs2], G2, NG2, [acc(Acc,NL,R)|NewAccs]) :- !,
258 ( ( OL == L1, OL \== L2 ) ->
259 MG1 = (G1,L1=L2), MG2 = G2, NL = L2
260 ; ( OL == L2, OL \== L1 ) ->
261 MG2 = (G2,L2=L1), MG1 = G1, NL = L1
262 ; MG1 = G1, MG2 = G2, L1 = L2, L2 = NL ),
263 '_merge_acc'(Accs, Accs1, MG1, NG1, Accs2, MG2, NG2, NewAccs).
264
266
268
270'_match'(L, H, _, _) :- L>H, !.
271'_match'(L, H, P, Q) :- L=<H, !,
272 arg(L, P, A),
273 arg(L, Q, A),
274 L1 is L+1,
275 '_match'(L1, H, P, Q).
276
277
278'_list'(L) :- nonvar(L), L=[_|_], !.
279'_list'(L) :- L==[], !.
280
281'_make_list'(A, [A]) :- \+'_list'(A), !.
282'_make_list'(L, L) :- '_list'(L), !.
283
285'_replace'(_, _, [], []).
286'_replace'(A, B, [A|L], [B|R]) :- !,
287 '_replace'(A, B, L, R).
288'_replace'(A, B, [C|L], [C|R]) :-
289 \+C=A, !,
290 '_replace'(A, B, L, R).
291
293
295
299'_new_goal'(Goal, GList, GArity, TGoal) :-
300 functor(Goal, Name, GArity),
301 '_number_args'(GList, GArity, TArity),
302 functor(TGoal, Name, TArity),
303 '_match'(1, GArity, Goal, TGoal).
304
306'_number_args'([], N, N).
307'_number_args'([A|List], N, M) :-
308 '_is_acc'(A), !,
309 N2 is N+2,
310 '_number_args'(List, N2, M).
311'_number_args'([A|List], N, M) :-
312 '_is_pass'(A), !,
313 N1 is N+1,
314 '_number_args'(List, N1, M).
315'_number_args'([_|List], N, M) :- !,
316 317 '_number_args'(List, N, M).
318
320'_has_hidden'(G, GList) :-
321 functor(G, GName, GArity),
322 pred_info(GName, GArity, GList).
323'_has_hidden'(G, []) :-
324 functor(G, GName, GArity),
325 \+pred_info(GName, GArity, _).
326
328'_is_acc'(A) :- atomic(A), !, '_acc_info'(A, _, _, _, _, _, _).
329'_is_acc'(A) :- functor(A, N, 2), !, '_acc_info'(N, _, _, _, _, _, _).
330
332'_is_pass'(A) :- atomic(A), !, '_pass_info'(A, _).
333'_is_pass'(A) :- functor(A, N, 1), !, '_pass_info'(N, _).
334
336'_acc_info'(AccParams, LStart, RStart) :-
337 functor(AccParams, Acc, 2),
338 '_is_acc'(Acc), !,
339 arg(1, AccParams, LStart),
340 arg(2, AccParams, RStart).
341'_acc_info'(Acc, LStart, RStart) :-
342 '_acc_info'(Acc, _, _, _, _, LStart, RStart).
343
345'_acc_info'(Acc, Term, Left, Right, Joiner, LStart, RStart) :-
346 acc_info(Acc, Term, Left, Right, Joiner, LStart, RStart).
347'_acc_info'(Acc, Term, Left, Right, Joiner, _, _) :-
348 acc_info(Acc, Term, Left, Right, Joiner).
349'_acc_info'(dcg, Term, Left, Right, Left=[Term|Right], _, []).
350
353'_pass_info'(PassParam, PStart) :-
354 functor(PassParam, Pass, 1),
355 '_is_pass'(Pass), !,
356 arg(1, PassParam, PStart).
357'_pass_info'(Pass, PStart) :-
358 pass_info(Pass, PStart).
359'_pass_info'(Pass, _) :-
360 pass_info(Pass).
361
363'_joiner'([], _, _, true, Acc, Acc).
364'_joiner'([Term|List], A, NaAr, (Joiner,LJoiner), Acc, NewAcc) :-
365 '_replace_acc'(A, LeftA, RightA, MidA, RightA, Acc, MidAcc),
366 '_acc_info'(A, Term, LeftA, MidA, Joiner, _, _), !,
367 '_joiner'(List, A, NaAr, LJoiner, MidAcc, NewAcc).
369'_joiner'([_Term|List], A, NaAr, Joiner, Acc, NewAcc) :-
370 print_message(warning, missing_accumulator(NaAr,A)),
371 '_joiner'(List, A, NaAr, Joiner, Acc, NewAcc).
372
374'_replace_defaults'([], [], _).
375'_replace_defaults'([A|GList], [NA|NGList], AList) :-
376 '_replace_default'(A, NA, AList),
377 '_replace_defaults'(GList, NGList, AList).
378
379'_replace_default'(A, NewA, AList) :- 380 functor(NewA, A, 2),
381 member(NewA, AList), !.
382'_replace_default'(A, NewA, AList) :- 383 functor(NewA, A, 1),
384 member(NewA, AList), !.
385'_replace_default'(A, NewA, _) :- 386 A=NewA.
387
389
390:- multifile prolog:message//1. 391
392prolog:message(missing_accumulator(Predicate,Accumulator)) -->
393 ['In ~w the accumulator ''~w'' does not exist'-[Predicate,Accumulator]].
394prolog:message(missing_hidden_parameter(Predicate,Term)) -->
395 ['In ~w the term ''~w'' uses a non-existent hidden parameter.'-[Predicate,Term]].
396prolog:message(not_a_hidden_param(Name)) -->
397 ['~w is not a hidden parameter'-[Name]]