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-2024, 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, Clause, Pos) =>
   74    Clause = (H:-B0,B1),
   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, Clause, Pos) =>
   83    Clause = (H:-B),
   84    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
   85    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
   86    '$current_source_module'(M),
   87    Qualify = q(M,M,_),
   88    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
   89dcg_translate_rule((LP,MNT==>RP), Pos0, Clause, Pos), is_list(MNT) =>
   90    Clause = (H=>B0,B1),
   91    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
   92    f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
   93    '$current_source_module'(M),
   94    Qualify = q(M,M,_),
   95    dcg_extend(LP, PosLP0, S0, SR, H, PosLP),
   96    dcg_body(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
   97    dcg_body(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT).
   98dcg_translate_rule((LP,Grd==>RP), Pos0, Clause, Pos) =>
   99    Clause = (H,Grd=>B),
  100    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
  101    f2_pos(PosH0, PosLP0, PosGrd, PosH, PosLP, PosGrd),
  102    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
  103    '$current_source_module'(M),
  104    Qualify = q(M,M,_),
  105    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
  106dcg_translate_rule((LP==>RP), Pos0, Clause, Pos) =>
  107    Clause = (H=>B),
  108    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
  109    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
  110    '$current_source_module'(M),
  111    Qualify = q(M,M,_),
  112    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).

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

Translate DCG body term.

  118dcg_body(Var, P0, Q, S, SR, phrase(QVar, S, SR), P) :-
  119    var(Var),
  120    !,
  121    qualify(Q, Var, P0, QVar, P).
  122dcg_body(M:X, Pos0, q(_,C,_), S, SR, Ct, Pos) :-
  123    !,
  124    f2_pos(Pos0, _, XP0, _, _, _),
  125    dcg_body(X, XP0, q(M,C,Pos0), S, SR, Ct, Pos).
  126dcg_body([], P0, _, S, SR, S=SR, P) :-         % Terminals
  127    !,
  128    dcg_terminal_pos(P0, P).
  129dcg_body(List, P0, _, S, SR, C, P) :-
  130    (   List = [_|_]
  131    ->  !,
  132        (   is_list(List)
  133        ->  '$append'(List, SR, OL),        % open the list
  134            C = (S = OL)
  135        ;   '$skip_list'(_, List, Tail),
  136            var(Tail)
  137        ->  C = '$append'(List, SR, S)      % TBD: Can be optimized
  138        ;   '$type_error'(list_or_partial_list, List)
  139        )
  140    ;   string(List)                        % double_quotes = string
  141    ->  !,
  142        string_codes(List, Codes),
  143        '$append'(Codes, SR, OL),
  144        C = (S = OL)
  145    ),
  146    dcg_terminal_pos(P0, P).
  147dcg_body(!, P0, _, S, SR, (!, SR = S), P) :-
  148    !,
  149    dcg_cut_pos(P0, P).
  150dcg_body({}, P, _, S, S, true, P) :- !.
  151dcg_body({T}, P0, Q, S, SR, (QT, SR = S), P) :-
  152    !,
  153    dcg_bt_pos(P0, P1),
  154    qualify(Q, T, P1, QT, P).
  155dcg_body((T,R), P0, Q, S, SR, (Tt, Rt), P) :-
  156    !,
  157    f2_pos(P0, PA0, PB0, P, PA, PB),
  158    dcg_body(T, PA0, Q, S, SR1, Tt, PA),
  159    dcg_body(R, PB0, Q, SR1, SR, Rt, PB).
  160dcg_body((T;R), P0, Q, S, SR, (Tt;Rt), P) :-
  161    !,
  162    f2_pos(P0, PA0, PB0, P, PA, PB),
  163    dcg_body(T, PA0, Q, S, S1, T1, PA), or_delay_bind(S, SR, S1, T1, Tt),
  164    dcg_body(R, PB0, Q, S, S2, R1, PB), or_delay_bind(S, SR, S2, R1, Rt).
  165dcg_body((T|R), P0, Q, S, SR, (Tt;Rt), P) :-
  166    !,
  167    f2_pos(P0, PA0, PB0, P, PA, PB),
  168    dcg_body(T, PA0, Q, S, S1, T1, PA), or_delay_bind(S, SR, S1, T1, Tt),
  169    dcg_body(R, PB0, Q, S, S2, R1, PB), or_delay_bind(S, SR, S2, R1, Rt).
  170dcg_body((C->T), P0, Q, S, SR, (Ct->Tt), P) :-
  171    !,
  172    f2_pos(P0, PA0, PB0, P, PA, PB),
  173    dcg_body(C, PA0, Q, S, SR1, Ct, PA),
  174    dcg_body(T, PB0, Q, SR1, SR, Tt, PB).
  175dcg_body((C*->T), P0, Q, S, SR, (Ct*->Tt), P) :-
  176    !,
  177    f2_pos(P0, PA0, PB0, P, PA, PB),
  178    dcg_body(C, PA0, Q, S, SR1, Ct, PA),
  179    dcg_body(T, PB0, Q, SR1, SR, Tt, PB).
  180dcg_body((\+ C), P0, Q, S, SR, (\+ Ct, SR = S), P) :-
  181    !,
  182    f1_pos(P0, PA0, P, PA),
  183    dcg_body(C, PA0, Q, S, _, Ct, PA).
  184dcg_body(T, P0, Q, S, SR, QTt, P) :-
  185    dcg_extend(T, P0, S, SR, Tt, P1),
  186    qualify(Q, Tt, P1, QTt, P).
  187
  188or_delay_bind(S, SR, S1, T, (T, SR=S)) :-
  189    S1 == S,
  190    !.
  191or_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.

  199qualify(q(M,C,_), X0, Pos0, X, Pos) :-
  200    M == C,
  201    !,
  202    X = X0,
  203    Pos = Pos0.
  204qualify(q(M,_,MP), X, Pos0, M:X, Pos) :-
  205    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.

  215:- dynamic  dcg_extend_cache/4.  216:- volatile dcg_extend_cache/4.  217
  218dcg_no_extend([]).
  219dcg_no_extend([_|_]).
  220dcg_no_extend({_}).
  221dcg_no_extend({}).
  222dcg_no_extend(!).
  223dcg_no_extend((\+_)).
  224dcg_no_extend((_,_)).
  225dcg_no_extend((_;_)).
  226dcg_no_extend((_|_)).
  227dcg_no_extend((_->_)).
  228dcg_no_extend((_*->_)).
  229dcg_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.

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

  302dcg_bt_pos(Var, Var) :-
  303    var(Var),
  304    !.
  305dcg_bt_pos(brace_term_position(F,T,P0),
  306           term_position(F,T,F,F,
  307                         [ P0,
  308                           term_position(T,T,T,T,_)
  309                         ])) :- !.
  310dcg_bt_pos(Pos, _) :-
  311    expected_layout(brace_term, Pos).
  312
  313dcg_cut_pos(Var, Var) :-
  314    var(Var),
  315    !.
  316dcg_cut_pos(F-T, term_position(F,T,F,T,
  317                               [ F-T,
  318                                 term_position(T,T,T,T,_)
  319                               ])).
  320dcg_cut_pos(Pos, _) :-
  321    expected_layout(atomic, Pos).

 dcg_terminal_pos(+ListPos, -TermPos)

  325dcg_terminal_pos(Pos, _) :-
  326    var(Pos),
  327    !.
  328dcg_terminal_pos(list_position(F,T,_Elms,_Tail),
  329                 term_position(F,T,_,_,_)).
  330dcg_terminal_pos(F-T,
  331                 term_position(F,T,_,_,_)).
  332dcg_terminal_pos(string_position(F,T),
  333                 term_position(F,T,_,_,_)).
  334dcg_terminal_pos(Pos, _) :-
  335    expected_layout(terminal, Pos).

 dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)

  339dcg_qualify_pos(Var, _, _) :-
  340    var(Var),
  341    !.
  342dcg_qualify_pos(Pos,
  343                term_position(F,T,FF,FT,[MP,_]),
  344                term_position(F,T,FF,FT,[MP,Pos])) :- !.
  345dcg_qualify_pos(_, Pos, _) :-
  346    expected_layout(f2, Pos).
  347
  348expected_layout(Expected, Found) :-
  349    '$expand':expected_layout(Expected, Found).
  350
  351
  352                 /*******************************
  353                 *       PHRASE INTERFACE       *
  354                 *******************************/

 phrase(:RuleSet, ?List)

 phrase(:RuleSet, ?List, ?Rest)

Interface to DCGs

  361:- meta_predicate
  362    phrase(//, ?),
  363    phrase(//, ?, ?),
  364    call_dcg(//, ?, ?).  365:- noprofile((phrase/2,
  366              phrase/3,
  367              call_dcg/3)).  368:- '$iso'((phrase/2, phrase/3)).  369
  370phrase(RuleSet, Input) :-
  371    phrase(RuleSet, Input, []).
  372phrase(RuleSet, Input, Rest) :-
  373    phrase_input(Input),
  374    phrase_input(Rest),
  375    call_dcg(RuleSet, Input, Rest).
  376
  377call_dcg(RuleSet, Input, Rest) :-
  378    (   strip_module(RuleSet, M, Plain),
  379        nonvar(Plain),
  380        dcg_special(Plain)
  381    ->  dcg_body(Plain, _, q(M,M,_), S0, S, Body, _),
  382        Input = S0, Rest = S,
  383        call(M:Body)
  384    ;   call(RuleSet, Input, Rest)
  385    ).
  386
  387phrase_input(Var) :- var(Var), !.
  388phrase_input([_|_]) :- !.
  389phrase_input([]) :- !.
  390phrase_input(Data) :-
  391    throw(error(type_error(list, Data), _)).
  392
  393dcg_special(S) :-
  394    string(S).
  395dcg_special((_,_)).
  396dcg_special((_;_)).
  397dcg_special((_|_)).
  398dcg_special((_->_)).
  399dcg_special(!).
  400dcg_special({_}).
  401dcg_special([]).
  402dcg_special([_|_]).
  403dcg_special(\+_)