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          ]).   44
   45/** <module> Grammar rule (DCG) compiler
   46
   47This module provides the  term-expansion  rules   for  DCGs  as  well as
   48phrase/2,3 and call_dcg/3 for calling DCGs. The original code was copied
   49from C-Prolog and written by Fernando  Pereira, EDCAAD, Edinburgh, 1984.
   50Since then many people have modified and extended this code.
   51
   52DCGs have for a long time been a moving target, notably when it comes to
   53dealing with cuts and unification delaying   for  calls to non-DCG code.
   54This has slowly converged. This implementation   attempts  to be closely
   55compatible to the pending ISO standard for DCGs.
   56*/
   57
   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).
  101
  102%!  dcg_body(:DCG, ?Pos0, +Qualify, ?List, ?Tail, -Goal, -Pos) is det.
  103%
  104%   Translate DCG body term.
  105
  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).
  177
  178%!  qualify(+QualifyInfo, +Goal, +Pos0, -QGoal, -Pos) is det.
  179%
  180%   @arg QualifyInfo is a term   q(Module,Context,Pos), where Module
  181%   is the module in which Goal must   be  called and Context is the
  182%   current source module.
  183
  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).
  191
  192
  193%!  dcg_extend(+Head, +Extra1, +Extra2, -NewHead)
  194%
  195%   Extend Head with two more arguments (on behalf DCG compilation).
  196%   The solution below is one option. Using   =..  and append is the
  197%   alternative. In the current version (5.3.2), the =.. is actually
  198%   slightly faster, but it creates less garbage.
  199
  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((_-->_)).
  215
  216%!  dcg_extend(:Rule, ?Pos0, ?List, ?Tail, -Head, -Pos) is det.
  217%
  218%   Extend a non-terminal with the   DCG  difference list List\Tail.
  219%   The position term is extended as well   to reflect the layout of
  220%   the created term. The additional variables   are  located at the
  221%   end of the Rule.
  222
  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).
  282
  283%!  dcg_bt_pos(?BraceTermPos, -Pos) is det.
  284%
  285%   Position transformation for mapping of {G} to (G, S=SR).
  286
  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).
  307
  308%!  dcg_terminal_pos(+ListPos, -TermPos)
  309
  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).
  321
  322%!  dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)
  323
  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                 *******************************/
  340
  341%!  phrase(:RuleSet, ?List).
  342%!  phrase(:RuleSet, ?List, ?Rest).
  343%
  344%   Interface to DCGs
  345
  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(\+_)