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

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

Translate DCG body term.

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

  174qualify(q(M,C,_), X0, Pos0, X, Pos) :-
  175    M == C,
  176    !,
  177    X = X0,
  178    Pos = Pos0.
  179qualify(q(M,_,MP), X, Pos0, M:X, Pos) :-
  180    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.

  190:- dynamic  dcg_extend_cache/4.  191:- volatile dcg_extend_cache/4.  192
  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((_*->_)).
  204dcg_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.

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

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

 dcg_terminal_pos(+ListPos, -TermPos)

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

 dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)

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

 phrase(:RuleSet, ?List)

 phrase(:RuleSet, ?List, ?Rest)

Interface to DCGs

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