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-2025, 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          ]).

   58dcg_translate_rule(Rule, Clause) :-
   59    dcg_translate_rule(Rule, _, Clause, _).
   60
   61dcg_translate_rule((LP,MNT-->RP), Pos0, Clause, Pos) =>
   62    Clause = (H:-B0,B1),
   63    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
   64    f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
   65    '$current_source_module'(M),
   66    Qualify = q(M,M,_),
   67    dcg_extend(LP, PosLP0, S0, SR, H, PosLP),
   68    dcg_body(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
   69    dcg_body(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT).
   70dcg_translate_rule((LP-->RP), Pos0, Clause, Pos) =>
   71    Clause = (H:-B),
   72    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
   73    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
   74    '$current_source_module'(M),
   75    Qualify = q(M,M,_),
   76    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
   77dcg_translate_rule((LP,MNT==>RP), Pos0, Clause, Pos), is_list(MNT) =>
   78    Clause = (H=>B0,B1),
   79    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
   80    f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
   81    '$current_source_module'(M),
   82    Qualify = q(M,M,_),
   83    dcg_extend(LP, PosLP0, S0, SR, H, PosLP),
   84    dcg_body(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
   85    dcg_body(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT).
   86dcg_translate_rule((LP,Grd==>RP), Pos0, Clause, Pos) =>
   87    Clause = (H,Grd=>B),
   88    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
   89    f2_pos(PosH0, PosLP0, PosGrd, PosH, PosLP, PosGrd),
   90    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
   91    '$current_source_module'(M),
   92    Qualify = q(M,M,_),
   93    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
   94dcg_translate_rule((LP==>RP), Pos0, Clause, Pos) =>
   95    Clause = (H=>B),
   96    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
   97    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
   98    '$current_source_module'(M),
   99    Qualify = q(M,M,_),
  100    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).

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

Translate DCG body term.

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

  184qualify(q(M,C,_), X0, Pos0, X, Pos) :-
  185    M == C,
  186    !,
  187    X = X0,
  188    Pos = Pos0.
  189qualify(q(M,_,MP), X, Pos0, M:X, Pos) :-
  190    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.

  200:- dynamic  dcg_extend_cache/4.  201:- volatile dcg_extend_cache/4.  202
  203dcg_no_extend([]).
  204dcg_no_extend([_|_]).
  205dcg_no_extend({_}).
  206dcg_no_extend({}).
  207dcg_no_extend(!).
  208dcg_no_extend((\+_)).
  209dcg_no_extend((_,_)).
  210dcg_no_extend((_;_)).
  211dcg_no_extend((_|_)).
  212dcg_no_extend((_->_)).
  213dcg_no_extend((_*->_)).
  214dcg_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.

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

  287dcg_bt_pos(Var, Var) :-
  288    var(Var),
  289    !.
  290dcg_bt_pos(brace_term_position(F,T,P0),
  291           term_position(F,T,F,F,
  292                         [ P0,
  293                           term_position(T,T,T,T,_)
  294                         ])) :- !.
  295dcg_bt_pos(Pos, _) :-
  296    expected_layout(brace_term, Pos).
  297
  298dcg_cut_pos(Var, Var) :-
  299    var(Var),
  300    !.
  301dcg_cut_pos(F-T, term_position(F,T,F,T,
  302                               [ F-T,
  303                                 term_position(T,T,T,T,_)
  304                               ])).
  305dcg_cut_pos(Pos, _) :-
  306    expected_layout(atomic, Pos).

 dcg_terminal_pos(+ListPos, -TermPos)

  310dcg_terminal_pos(Pos, _) :-
  311    var(Pos),
  312    !.
  313dcg_terminal_pos(list_position(F,T,_Elms,_Tail),
  314                 term_position(F,T,_,_,_)).
  315dcg_terminal_pos(F-T,
  316                 term_position(F,T,_,_,_)).
  317dcg_terminal_pos(string_position(F,T),
  318                 term_position(F,T,_,_,_)).
  319dcg_terminal_pos(Pos, _) :-
  320    expected_layout(terminal, Pos).

 dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)

  324dcg_qualify_pos(Var, _, _) :-
  325    var(Var),
  326    !.
  327dcg_qualify_pos(Pos,
  328                term_position(F,T,FF,FT,[MP,_]),
  329                term_position(F,T,FF,FT,[MP,Pos])) :- !.
  330dcg_qualify_pos(_, Pos, _) :-
  331    expected_layout(f2, Pos).
  332
  333expected_layout(Expected, Found) :-
  334    '$expand':expected_layout(Expected, Found).
  335
  336
  337                 /*******************************
  338                 *       PHRASE INTERFACE       *
  339                 *******************************/

 phrase(:RuleSet, ?List)

 phrase(:RuleSet, ?List, ?Rest)

Interface to DCGs

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