1:- module(dcg4pt, [
    2    dcg4pt_rules_to_dcg_rules/0,
    3    dcg4pt_rule_to_dcg_rule/2,
    4    sequence/5,
    5    call_sequence_ground/6
    6  ]).    7
    8prolog:message(warn(Text)) --> [Text].
    9
   10dcg4pt_rules_to_dcg_rules :-
   11  forall( X1 --> Y1,
   12    ( dcg4pt_rule_to_dcg_rule(X1 --> Y1, X2 --> Y2),
   13      expand_term(X2 --> Y2, Rule),
   14      assert(Rule) ) ).
   15
   16dcg4pt_rule_to_dcg_rule(X1 --> Y1, X2 --> Y2) :-
   17  X1 =.. [H|_],
   18  Res =.. [H, V],
   19  term_args_attached(X1, [Res], X2),
   20  dcg4pt_formula_to_dcg_formula(Y1, Y2, V).
   21
   22dcg4pt_formula_to_dcg_formula({ P }, { P }, []).
   23dcg4pt_formula_to_dcg_formula(!, !, []).
   24dcg4pt_formula_to_dcg_formula(\+ Y1, \+ Y2, _) :-
   25  dcg4pt_formula_to_dcg_formula(Y1, Y2, _).
   26dcg4pt_formula_to_dcg_formula(Y1, Y2, V) :-
   27  Y1 = (_,_),
   28  term_functors_list(Y1, [(,)], Ys1),
   29  maplist(conj_body, Ys1, Ys2, R0s, R1s),
   30  R0s = [V|R0s_], % take first
   31  append(R1s_, [Last], R1s),
   32  Last = [],
   33  maplist((=), R0s_, R1s_),
   34  term_functors_list(Y2, [(,)], Ys2).
   35dcg4pt_formula_to_dcg_formula(Y1, Y2, V) :-
   36  (Y1 = (_;_) ; Y1 = (_|_)),
   37  term_functors_list(Y1, [(;), '|'], Ys1),
   38  maplist(dcg4pt_formula_to_dcg_formula, Ys1, Ys2, Vs),
   39  maplist(add_variable_binding(V), Ys2, Vs, Ysn2),
   40  term_functors_list(Y2, [(;)], Ysn2).
   41dcg4pt_formula_to_dcg_formula([SingleTerminal], [SingleTerminal], SingleTerminal).
   42dcg4pt_formula_to_dcg_formula(Terminals, Terminals, Terminals) :-
   43  is_list(Terminals).
   44dcg4pt_formula_to_dcg_formula(Y1, Y1, Y1) :-
   45  string(Y1).
   46dcg4pt_formula_to_dcg_formula(Y1, Y2, V) :-
   47  term_args_attached(Y1, [V], Y2).
   48
   49add_variable_binding(Bind, X2, V, ({ Bind = V }, X2)).
   50
   51term_args_attached(X1, Vs, X2) :-
   52  X1 =.. As1,
   53  append(As1, Vs, As2),
   54  X2 =.. As2.
   55
   56conj_body(A, B, R0, R1) :-
   57  A = *(C),
   58  conj_body(sequence('*', C), B, R0, R1).
   59conj_body(A, B, R0, R1) :-
   60  A = ?(C),
   61  conj_body(sequence('?', C), B, R0, R1).
   62conj_body(A, B, R0, R1) :-
   63  A = sequence(_, _), !,
   64  dcg4pt_formula_to_dcg_formula(A, DCGBody, V),
   65  % B = ({ append(V, R1, R0) }, DCGBody).
   66  B = call_sequence_ground(DCGBody, V, R1, R0).
   67conj_body(A, B, R0, R1) :-
   68  dcg4pt_formula_to_dcg_formula(A, DCGBody, V),
   69  B = (
   70    { R0 = [V|R1] },
   71    DCGBody
   72  ).
   73
   74% meta-call predicates
   75
   76/*
   77  call_sequence_ground(DCGBody, V, Tree_List_Rest, In, Out) <-
   78
   79  V is the last argument of DCGBody, so it's the generated
   80  parsing tree. Originally, we want to simply call
   81    phrase(DCGBody, In, Out)
   82  and put its result V in front of the remaining list R1
   83  to get R0, i.e.:
   84    Translated_Body = (DCGBody, { append(V, R1, R0) })
   85  However, there are two possibilities, depending on whether
   86  phrase(some(?Tree),?In,?Out) is called with the `In`
   87  bound or `Tree`. In the first case we want to generate
   88  the appropriate parsing tree; in the latter case the
   89  input list for a corresponding parsing tree should be
   90  generated. That's why we need two different translated
   91  rule bodies: either by calling the DCGBody at first;
   92  or by splitting the list of parsing tree elements at
   93  first. The latter case is equivalent to:
   94    Translated_Body = ({ append(V, R1, R0) }, DCGBody)
   95  The meta-predicate call_sequence_ground/6 applies this
   96  distinction and calls the translated body in the right
   97  order.
   98*/
   99:- meta_predicate call_sequence_ground(//, ?, ?, ?, ?, ?).  100call_sequence_ground(DCGBody, V, R1, R0, In, Out) :-
  101  \+ var(R0),
  102  !, % parse tree bound
  103  append(V, R1, R0),
  104  phrase(DCGBody, In, Out).
  105call_sequence_ground(DCGBody, V, R1, R0, In, Out) :-
  106  (\+ var(In) ; attvar(In), get_attr(In, pure_input, _PIO)),
  107  !, % input bound
  108  phrase(DCGBody, In, Out),
  109  append(V, R1, R0).
  110call_sequence_ground(DCGBody, V, R1, R0, In, Out) :-
  111  var(R0),
  112  var(In),
  113  !, % parse tree and input unbound
  114  /*
  115    Normally, this is not intended. Consider the DCG
  116      symbol  --> ['a'] | ['b'].
  117      symbols --> sequence('*', symbol).
  118    With both input and parse tree arguments being
  119    unbound, this will generate "", "a", "aa", "aaa",
  120    etc., which most likely will not end in the
  121    expected result. For instance,
  122      ?- phrase(symbols(PT), In), In = ['b'].
  123    will not terminate, as it is first backtracked
  124    over the sequence, not the symbols.
  125    Therefore, we show a warning here.
  126  */
  127  print_message(warning, warn('Parse tree AND input unbound; this might not work as expected!')),
  128  phrase(DCGBody, In, Out),
  129  append(V, R1, R0).
  130
  131:- meta_predicate sequence(?, //, ?, ?, ?).  132
  133sequence('?', DCGBody, [PT]) --> call(DCGBody, PT).
  134sequence('?', _, []) --> [].
  135
  136sequence('*', _, []) --> [].
  137sequence('*', DCGBody, [PT|PTs]) -->
  138  call(DCGBody, PT),
  139  sequence('*', DCGBody, PTs).
  140
  141sequence('**', DCGBody, [PT|PTs]) -->
  142  call(DCGBody, PT),
  143  sequence('**', DCGBody, PTs).
  144sequence('**', _, []) --> [].
  145
  146sequence('+', DCGBody, [PT|PTs]) -->
  147  call(DCGBody, PT),
  148  sequence('*', DCGBody, PTs).
  152term_functors_list(Term, Names, [A,B|Rest]) :-
  153  member(Name, Names),
  154  Term =.. [Name, A, TermB],
  155  term_functors_list(TermB, Names, [B|Rest]).
  156term_functors_list(A, _, [A])