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)