1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2009-2016, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module('$dcg',
   37          [ dcg_translate_rule/2,       % +Rule, -Clause
   38            dcg_translate_rule/4,       % +Rule, ?Pos0, -Clause, -Pos
   39            phrase/2,                   % :Rule, ?Input
   40            phrase/3,                   % :Rule, ?Input, ?Rest
   41            call_dcg/3                  % :Rule, ?State0, ?State
   42          ]).   43
   44                /********************************
   45                *        GRAMMAR RULES          *
   46                *********************************/
   47
   48/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   49The DCG compiler. The original code was copied from C-Prolog and written
   50by Fernando Pereira, EDCAAD, Edinburgh,  1984.   Since  then many people
   51have modified and extended this code. It's a nice mess now and it should
   52be redone from scratch. I won't be doing   this  before I get a complete
   53spec explaining all an implementor needs to   know  about DCG. I'm a too
   54basic user of this facility myself (though   I  learned some tricks from
   55people reporting bugs :-)
   56
   57The original version contained '$t_tidy'/2  to   convert  ((a,b),  c) to
   58(a,(b,c)). As the resulting code is the   same,  this was removed. Since
   59version 8.5.6 we also removed moving matches   to the first literal into
   60the head as this is done by the compiler, e.g.
   61
   62   t --> [x]
   63
   64Translated  into  `t(L0,L)  :-  L0  =   [x|L]`.  SWI-Prolog  moves  head
   65unifications immedately following the neck into   the  head and thus the
   66DCG compiler no longer needs to do so.
   67- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   68
   69dcg_translate_rule(Rule, Clause) :-
   70    dcg_translate_rule(Rule, _, Clause, _).
   71
   72dcg_translate_rule(((LP,MNT)-->RP), Pos0, (H:-B0,B1), Pos) :-
   73    !,
   74    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
   75    f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
   76    '$current_source_module'(M),
   77    Qualify = q(M,M,_),
   78    dcg_extend(LP, PosLP0, S0, SR, H, PosLP),
   79    dcg_body(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
   80    dcg_body(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT).
   81dcg_translate_rule((LP-->RP), Pos0, (H:-B), Pos) :-
   82    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
   83    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
   84    '$current_source_module'(M),
   85    Qualify = q(M,M,_),
   86    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).

 dcg_body(:DCG, ?Pos0, +Qualify, ?List, ?Tail, -Goal, -Pos) is det

Translate DCG body term.

   92dcg_body(Var, P0, Q, S, SR, phrase(QVar, S, SR), P) :-
   93    var(Var),
   94    !,
   95    qualify(Q, Var, P0, QVar, P).
   96dcg_body(M:X, Pos0, q(_,C,_), S, SR, Ct, Pos) :-
   97    !,
   98    f2_pos(Pos0, _, XP0, _, _, _),
   99    dcg_body(X, XP0, q(M,C,Pos0), S, SR, Ct, Pos).
  100dcg_body([], P0, _, S, SR, S=SR, P) :-         % Terminals
  101    !,
  102    dcg_terminal_pos(P0, P).
  103dcg_body(List, P0, _, S, SR, C, P) :-
  104    (   List = [_|_]
  105    ->  !,
  106        (   is_list(List)
  107        ->  '$append'(List, SR, OL),        % open the list
  108            C = (S = OL)
  109        ;   '$skip_list'(_, List, Tail),
  110            var(Tail)
  111        ->  C = '$append'(List, SR, S)      % TBD: Can be optimized
  112        ;   '$type_error'(list_or_partial_list, List)
  113        )
  114    ;   string(List)                        % double_quotes = string
  115    ->  !,
  116        string_codes(List, Codes),
  117        '$append'(Codes, SR, OL),
  118        C = (S = OL)
  119    ),
  120    dcg_terminal_pos(P0, P).
  121dcg_body(!, P0, _, S, SR, (!, SR = S), P) :-
  122    !,
  123    dcg_cut_pos(P0, P).
  124dcg_body({}, P, _, S, S, true, P) :- !.
  125dcg_body({T}, P0, Q, S, SR, (QT, SR = S), P) :-
  126    !,
  127    dcg_bt_pos(P0, P1),
  128    qualify(Q, T, P1, QT, P).
  129dcg_body((T,R), P0, Q, S, SR, (Tt, Rt), P) :-
  130    !,
  131    f2_pos(P0, PA0, PB0, P, PA, PB),
  132    dcg_body(T, PA0, Q, S, SR1, Tt, PA),
  133    dcg_body(R, PB0, Q, SR1, SR, Rt, PB).
  134dcg_body((T;R), P0, Q, S, SR, (Tt;Rt), P) :-
  135    !,
  136    f2_pos(P0, PA0, PB0, P, PA, PB),
  137    dcg_body(T, PA0, Q, S, S1, T1, PA), or_delay_bind(S, SR, S1, T1, Tt),
  138    dcg_body(R, PB0, Q, S, S2, R1, PB), or_delay_bind(S, SR, S2, R1, Rt).
  139dcg_body((T|R), P0, Q, S, SR, (Tt;Rt), P) :-
  140    !,
  141    f2_pos(P0, PA0, PB0, P, PA, PB),
  142    dcg_body(T, PA0, Q, S, S1, T1, PA), or_delay_bind(S, SR, S1, T1, Tt),
  143    dcg_body(R, PB0, Q, S, S2, R1, PB), or_delay_bind(S, SR, S2, R1, Rt).
  144dcg_body((C->T), P0, Q, S, SR, (Ct->Tt), P) :-
  145    !,
  146    f2_pos(P0, PA0, PB0, P, PA, PB),
  147    dcg_body(C, PA0, Q, S, SR1, Ct, PA),
  148    dcg_body(T, PB0, Q, SR1, SR, Tt, PB).
  149dcg_body((C*->T), P0, Q, S, SR, (Ct*->Tt), P) :-
  150    !,
  151    f2_pos(P0, PA0, PB0, P, PA, PB),
  152    dcg_body(C, PA0, Q, S, SR1, Ct, PA),
  153    dcg_body(T, PB0, Q, SR1, SR, Tt, PB).
  154dcg_body((\+ C), P0, Q, S, SR, (\+ Ct, SR = S), P) :-
  155    !,
  156    f1_pos(P0, PA0, P, PA),
  157    dcg_body(C, PA0, Q, S, _, Ct, PA).
  158dcg_body(T, P0, Q, S, SR, QTt, P) :-
  159    dcg_extend(T, P0, S, SR, Tt, P1),
  160    qualify(Q, Tt, P1, QTt, P).
  161
  162or_delay_bind(S, SR, S1, T, (T, SR=S)) :-
  163    S1 == S,
  164    !.
  165or_delay_bind(_S, SR, SR, T, T).

 qualify(+QualifyInfo, +Goal, +Pos0, -QGoal, -Pos) is det

Arguments:

QualifyInfo

- is a term q(Module,Context,Pos), where Module is the module in which Goal must be called and Context is the current source module.

  173qualify(q(M,C,_), X0, Pos0, X, Pos) :-
  174    M == C,
  175    !,
  176    X = X0,
  177    Pos = Pos0.
  178qualify(q(M,_,MP), X, Pos0, M:X, Pos) :-
  179    dcg_qualify_pos(Pos0, MP, Pos).

 dcg_extend(+Head, +Extra1, +Extra2, -NewHead)

Extend Head with two more arguments (on behalf DCG compilation). The solution below is one option. Using =.. and append is the alternative. In the current version (5.3.2), the =.. is actually slightly faster, but it creates less garbage.

  189:- dynamic  dcg_extend_cache/4.  190:- volatile dcg_extend_cache/4.  191
  192dcg_no_extend([]).
  193dcg_no_extend([_|_]).
  194dcg_no_extend({_}).
  195dcg_no_extend({}).
  196dcg_no_extend(!).
  197dcg_no_extend((\+_)).
  198dcg_no_extend((_,_)).
  199dcg_no_extend((_;_)).
  200dcg_no_extend((_|_)).
  201dcg_no_extend((_->_)).
  202dcg_no_extend((_*->_)).
  203dcg_no_extend((_-->_)).

 dcg_extend(:Rule, ?Pos0, ?List, ?Tail, -Head, -Pos) is det

Extend a non-terminal with the DCG difference list List\Tail. The position term is extended as well to reflect the layout of the created term. The additional variables are located at the end of the Rule.

  212dcg_extend(V, _, _, _, _, _) :-
  213    var(V),
  214    !,
  215    throw(error(instantiation_error,_)).
  216dcg_extend(M:OldT, Pos0, A1, A2, M:NewT, Pos) :-
  217    !,
  218    f2_pos(Pos0, MPos, P0, Pos, MPos, P),
  219    dcg_extend(OldT, P0, A1, A2, NewT, P).
  220dcg_extend(OldT, P0, A1, A2, NewT, P) :-
  221    dcg_extend_cache(OldT, A1, A2, NewT),
  222    !,
  223    extended_pos(P0, P).
  224dcg_extend(OldT, P0, A1, A2, NewT, P) :-
  225    (   callable(OldT)
  226    ->  true
  227    ;   throw(error(type_error(callable,OldT),_))
  228    ),
  229    (   dcg_no_extend(OldT)
  230    ->  throw(error(permission_error(define,dcg_nonterminal,OldT),_))
  231    ;   true
  232    ),
  233    (   compound(OldT)
  234    ->  compound_name_arity(OldT, Name, Arity),
  235        compound_name_arity(CopT, Name, Arity)
  236    ;   CopT = OldT,
  237        Name = OldT,
  238        Arity = 0
  239    ),
  240    NewArity is Arity+2,
  241    functor(NewT, Name, NewArity),
  242    copy_args(1, Arity, CopT, NewT),
  243    A1Pos is Arity+1,
  244    A2Pos is Arity+2,
  245    arg(A1Pos, NewT, A1C),
  246    arg(A2Pos, NewT, A2C),
  247    assert(dcg_extend_cache(CopT, A1C, A2C, NewT)),
  248    OldT = CopT,
  249    A1C = A1,
  250    A2C = A2,
  251    extended_pos(P0, P).
  252
  253copy_args(I, Arity, Old, New) :-
  254    I =< Arity,
  255    !,
  256    arg(I, Old, A),
  257    arg(I, New, A),
  258    I2 is I + 1,
  259    copy_args(I2, Arity, Old, New).
  260copy_args(_, _, _, _).
  261
  262
  263                 /*******************************
  264                 *        POSITION LOGIC        *
  265                 *******************************/
  266
  267extended_pos(Pos0, Pos) :-
  268    '$expand':extended_pos(Pos0, 2, Pos).
  269f2_pos(Pos0, A0, B0, Pos, A, B) :- '$expand':f2_pos(Pos0, A0, B0, Pos, A, B).
  270f1_pos(Pos0, A0, Pos, A) :- '$expand':f1_pos(Pos0, A0, Pos, A).

 dcg_bt_pos(?BraceTermPos, -Pos) is det

Position transformation for mapping of {G} to (G, S=SR).

  276dcg_bt_pos(Var, Var) :-
  277    var(Var),
  278    !.
  279dcg_bt_pos(brace_term_position(F,T,P0),
  280           term_position(F,T,F,F,
  281                         [ P0,
  282                           term_position(T,T,T,T,_)
  283                         ])) :- !.
  284dcg_bt_pos(Pos, _) :-
  285    expected_layout(brace_term, Pos).
  286
  287dcg_cut_pos(Var, Var) :-
  288    var(Var),
  289    !.
  290dcg_cut_pos(F-T, term_position(F,T,F,T,
  291                               [ F-T,
  292                                 term_position(T,T,T,T,_)
  293                               ])).
  294dcg_cut_pos(Pos, _) :-
  295    expected_layout(atomic, Pos).

 dcg_terminal_pos(+ListPos, -TermPos)

  299dcg_terminal_pos(Pos, _) :-
  300    var(Pos),
  301    !.
  302dcg_terminal_pos(list_position(F,T,_Elms,_Tail),
  303                 term_position(F,T,_,_,_)).
  304dcg_terminal_pos(F-T,
  305                 term_position(F,T,_,_,_)).
  306dcg_terminal_pos(Pos, _) :-
  307    expected_layout(terminal, Pos).

 dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)

  311dcg_qualify_pos(Var, _, _) :-
  312    var(Var),
  313    !.
  314dcg_qualify_pos(Pos,
  315                term_position(F,T,FF,FT,[MP,_]),
  316                term_position(F,T,FF,FT,[MP,Pos])) :- !.
  317dcg_qualify_pos(_, Pos, _) :-
  318    expected_layout(f2, Pos).
  319
  320expected_layout(Expected, Found) :-
  321    '$expand':expected_layout(Expected, Found).
  322
  323
  324                 /*******************************
  325                 *       PHRASE INTERFACE       *
  326                 *******************************/

 phrase(:RuleSet, ?List)

 phrase(:RuleSet, ?List, ?Rest)

Interface to DCGs

  333:- meta_predicate
  334    phrase(//, ?),
  335    phrase(//, ?, ?),
  336    call_dcg(//, ?, ?).  337:- noprofile((phrase/2,
  338              phrase/3,
  339              call_dcg/3)).  340:- '$iso'((phrase/2, phrase/3)).  341
  342phrase(RuleSet, Input) :-
  343    phrase(RuleSet, Input, []).
  344phrase(RuleSet, Input, Rest) :-
  345    phrase_input(Input),
  346    phrase_input(Rest),
  347    call_dcg(RuleSet, Input, Rest).
  348
  349call_dcg(RuleSet, Input, Rest) :-
  350    (   strip_module(RuleSet, M, Plain),
  351        nonvar(Plain),
  352        dcg_special(Plain)
  353    ->  dcg_body(Plain, _, q(M,M,_), S0, S, Body, _),
  354        Input = S0, Rest = S,
  355        call(M:Body)
  356    ;   call(RuleSet, Input, Rest)
  357    ).
  358
  359phrase_input(Var) :- var(Var), !.
  360phrase_input([_|_]) :- !.
  361phrase_input([]) :- !.
  362phrase_input(Data) :-
  363    throw(error(type_error(list, Data), _)).
  364
  365dcg_special(S) :-
  366    string(S).
  367dcg_special((_,_)).
  368dcg_special((_;_)).
  369dcg_special((_|_)).
  370dcg_special((_->_)).
  371dcg_special(!).
  372dcg_special({_}).
  373dcg_special([]).
  374dcg_special([_|_]).
  375dcg_special(\+_)