1:- module(peg_syntax, [
2 op(1200,xfx,<--),
3 op(1105,xfy,/),
4 op(700,xf,?),
5 op(700,xf,*),
6 op(700,xf,+),
7 op(700,fx,&),
8 op(700,fx,!),
9 peg_translate_rule/2
10 ]). 11
12:- '$hide'((<--)/2). 13
14peg_translate_rule((A <-- B), [A --> Body|T]) :-
15 functor(A, NA, _),
16 peg_expansion(NA, B, Body, 0, _, T-[]).
17
18peg_expansion(Name, (A, B), (ABody,BBody), M0, M2, Head-Tail1) :-
19 !,
20 peg_expansion(Name, A, ABody, M0, M1, Head-Tail0),
21 peg_expansion(Name, B, BBody, M1, M2, Tail0-Tail1).
22
23peg_expansion(Name, (A +), Plus, M0, M1, Out) :-
24 !,
25 plus_expansion(Name, A, Plus, M0, M1, Out).
26
27peg_expansion(Name, (A ?), Body, M0, M1, Out) :-
28 !,
29 peg_expansion(Name, (A / []), Body, M0, M1, Out).
30
31peg_expansion(Name, (A *), Star, M0, M1, Out) :-
32 !,
33 star_expansion(Name, A, Star, M0, M1, Out).
34
35peg_expansion(Name, (& A), And, M0, M1, Out) :-
36 !,
37 and_expansion(Name, A, And, M0, M1, Out).
38
39peg_expansion(Name, (! A), Not, M0, M1, Out) :-
40 !,
41 not_expansion(Name, A, Not, M0, M1, Out).
42
43peg_expansion(Name, (A / B), (ABody, !; BBody), M0, M2, Head-Tail1) :-
44 !,
45 peg_expansion(Name, A, ABody, M0, M1, Head-Tail0),
46 peg_expansion(Name, B, BBody, M1, M2, Tail0-Tail1).
47
48peg_expansion(_, Body, Body, M, M, X-X).
49
50
51and_expansion(Name, A, And, M0, M3, [(AndHead :- ExpresionIgnore),
52 (ExpresionHead --> ExpresionBody)|Tail0]-Tail1):-
53 !,
54 atomic_concat(Name, M0, NAnd),
55 succ(M0, M1),
56 atomic_concat(Name, M1, NExpresion),
57 succ(M1, M2),
58 term_variables(A, Vars),
59 append(Vars, [X,X], Arguments),
60 append(Vars, [X,_], CallArgs),
61 And =.. [NAnd|Vars],
62 AndHead =.. [NAnd|Arguments],
63 ExpresionIgnore =.. [NExpresion|CallArgs],
64 ExpresionHead =.. [NExpresion|Vars],
65 peg_expansion(Name, A, ExpresionBody, M2, M3, Tail0-Tail1).
66
67not_expansion(Name, A, And, M0, M3, [(AndHead :- \+ ExpresionIgnore),
68 (ExpresionHead --> ExpresionBody)|Tail0]-Tail1):-
69 !,
70 atomic_concat(Name, M0, NAnd),
71 succ(M0, M1),
72 atomic_concat(Name, M1, NExpresion),
73 succ(M1, M2),
74 term_variables(A, Vars),
75 append(Vars, [X,X], Arguments),
76 append(Vars, [X,_], CallArgs),
77 And =.. [NAnd|Vars],
78 AndHead =.. [NAnd|Arguments],
79 ExpresionIgnore =.. [NExpresion|CallArgs],
80 ExpresionHead =.. [NExpresion|Vars],
81 peg_expansion(Name, A, ExpresionBody, M2, M3, Tail0-Tail1).
82
83plus_expansion(Name, A, Plus, M0, M4, [(PlusPairs --> One, ManyTail),
84 (ManyPairs --> One, !, ManyTail),
85 (ManyNil --> []),
86 (One --> Body)|Tail0]-Tail1):-
87 !,
88 atomic_concat(Name, M0, NPlus),
89 succ(M0, M1),
90 atomic_concat(Name, M1, NMany),
91 succ(M1, M2),
92 atomic_concat(Name, M2, NOne),
93 succ(M2, M3),
94 term_variables(A, Vars),
95 maplist([[],P,H,T]>>(P=[H|T]), Nils, Pairs, Vars, Tails),
96 One =.. [NOne|Vars],
97 Plus =.. [NPlus|Vars],
98 PlusPairs =.. [NPlus|Pairs],
99 ManyPairs =.. [NMany|Pairs],
100 ManyTail =.. [NMany|Tails],
101 ManyNil =.. [NMany|Nils],
102 peg_expansion(Name, A, Body, M3, M4, Tail0-Tail1).
103
104star_expansion(Name, A, Many, M0, M3, [(ManyPairs --> One, !, ManyTail),
105 (ManyNil --> []),
106 (One --> Body)|Tail0]-Tail1):-
107 !,
108 atomic_concat(Name, M0, NMany),
109 succ(M0, M1),
110 atomic_concat(Name, M1, NOne),
111 succ(M1, M2),
112 term_variables(A, Vars),
113 maplist([[],P,H,T]>>(P=[H|T]), Nils, Pairs, Vars, Tails),
114 One =.. [NOne|Vars],
115 Many =.. [NMany|Vars],
116 ManyPairs =.. [NMany|Pairs],
117 ManyTail =.. [NMany|Tails],
118 ManyNil =.. [NMany|Nils],
119 peg_expansion(Name, A, Body, M2, M3, Tail0-Tail1).
120
121:- multifile term_expansion/2. 122
123system:term_expansion(In, Out) :-
124 peg_syntax:peg_translate_rule(In, Out)