1/*
    2	This Module is a modified version of SWI module '$dcg'.
    3	
    4	Optimisations and caching are disabled. 
    5	Is used by dcg_term_expansion to expand grammar bodies. 
    6*/
    7/*  Part of SWI-Prolog
    8
    9    Author:        Jan Wielemaker
   10    E-mail:        J.Wielemaker@vu.nl
   11    WWW:           http://www.swi-prolog.org
   12    Copyright (c)  2009-2016, University of Amsterdam
   13                              VU University Amsterdam
   14    All rights reserved.
   15
   16    Redistribution and use in source and binary forms, with or without
   17    modification, are permitted provided that the following conditions
   18    are met:
   19
   20    1. Redistributions of source code must retain the above copyright
   21       notice, this list of conditions and the following disclaimer.
   22
   23    2. Redistributions in binary form must reproduce the above copyright
   24       notice, this list of conditions and the following disclaimer in
   25       the documentation and/or other materials provided with the
   26       distribution.
   27
   28    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   29    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   30    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   31    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   32    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   33    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   34    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   35    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   36    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   37    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   38    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   39    POSSIBILITY OF SUCH DAMAGE.
   40*/
   41
   42:- module(dcg_hashswi,
   43          [ dcg_translate_rule_/2       % +Rule, -Clause
   44          ]).   45
   46:-  absolute_file_name(swi(boot/dcg),DcgFile), 
   47    ensure_loaded(DcgFile).   48
   49                /********************************
   50                *        GRAMMAR RULES          *
   51                *********************************/
   52
   53/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   54The DCG compiler. The original code was copied from C-Prolog and written
   55by Fernando Pereira, EDCAAD, Edinburgh,  1984.   Since  then many people
   56have modified and extended this code. It's a nice mess now and it should
   57be redone from scratch. I won't be doing   this  before I get a complete
   58spec explaining all an implementor needs to   know  about DCG. I'm a too
   59basic user of this facility myself (though   I  learned some tricks from
   60people reporting bugs :-)
   61
   62The original version contained '$t_tidy'/2  to   convert  ((a,b),  c) to
   63(a,(b,c)), but as the  SWI-Prolog  compiler   doesn't  really  care (the
   64resulting code is simply the same), I've removed that.
   65- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   66
   67/*
   68	DCG Term Expansion
   69	Modified DCG Expansion
   70	
   71	dcg_translate_rule_/2
   72	'$dcg':dcg_translate_rule/2 without optimisation
   73	Original can be found here:
   74	http://www.swi-prolog.org/pldoc/doc/_SWI_/boot/dcg.pl?show=src#dcg_translate_rule/2
   75*/
   76dcg_translate_rule_(Rule, Clause) :-
   77	dcg_translate_rule_(Rule, _, Clause, _).
   78dcg_translate_rule_(((LP,MNT)-->RP), Pos0, (H:-B), Pos) :-
   79	!,
   80	dcg_hashswi:f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
   81	dcg_hashswi:f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
   82	'$current_source_module'(M),
   83	Qualify = q(M,M,_),
   84	dcg_extend_(LP, PosLP0, S0, SR, H, PosLP),
   85	dcg_body_(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
   86	dcg_body_(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT),
   87	B = (B0, B1).
   88	%dcg_optimise((B0,B1),B2,S0),
   89	%dcg_optimise(B2,B,SR).
   90dcg_translate_rule_((LP-->RP), Pos0, (H:-B), Pos) :-
   91	dcg_hashswi:f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
   92	dcg_extend_(LP, PosLP0, S0, S, H, PosLP),
   93	'$current_source_module'(M),
   94	Qualify = q(M,M,_),
   95	dcg_body_(RP, PosRP0, Qualify, S0, S, B, PosRP).
   96	%dcg_optimise(B0,B,S0).

 dcg_optimise(+BodyIn, -Body, +S0) is det

Performs the following translations:

• a(H,T) :- H = [a,b|T], b(T), ... into a([a,b|T0]) :- b(T0, T).
• a(H,T) :- H = [a,b|T] into a([a,b|T0])

Arguments:

S0	- is the initial input list of the rule.

  108/*
  109dcg_optimise((S00=X,B), B, S0) :-
  110    S00 == S0,
  111    !,
  112    S0 = X.
  113dcg_optimise(S00=X, B, S0) :-
  114    S00 == S0,
  115    !,
  116    S0 = X,
  117    B = true.
  118dcg_optimise(B, B, _).
  119*/

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

Translate DCG body term.

  125/*
  126	dcg_body_/7
  127	
  128	'$dcg':dcg_body/7 without caching
  129	http://www.swi-prolog.org/pldoc/doc/_SWI_/boot/dcg.pl?show=src#dcg_body/7
  130*/
  131dcg_body_(Var, P0, Q, S, SR, phrase(QVar, S, SR), P) :-
  132    var(Var),
  133    !,
  134    dcg_hashswi:qualify(Q, Var, P0, QVar, P).
  135dcg_body_(M:X, Pos0, q(_,C,_), S, SR, Ct, Pos) :-
  136    !,
  137    dcg_hashswi:f2_pos(Pos0, _, XP0, _, _, _),
  138    dcg_body_(X, XP0, q(M,C,Pos0), S, SR, Ct, Pos).
  139dcg_body_([], P0, _, S, SR, S=SR, P) :-         % Terminals
  140    !,
  141    dcg_hashswi:dcg_terminal_pos(P0, P).
  142dcg_body_(List, P0, _, S, SR, C, P) :-
  143    (   List = [_|_]
  144    ->  !,
  145        (   is_list(List)
  146        ->  '$append'(List, SR, OL),        % open the list
  147            C = (S = OL)
  148        ;   '$skip_list'(_, List, Tail),
  149            var(Tail)
  150        ->  C = '$append'(List, SR, S)      % TBD: Can be optimized
  151        ;   '$type_error'(list_or_partial_list, List)
  152        )
  153    ;   string(List)                        % double_quotes = string
  154    ->  !,
  155        string_codes(List, Codes),
  156        '$append'(Codes, SR, OL),
  157        C = (S = OL)
  158    ),
  159    dcg_hashswi:dcg_terminal_pos(P0, P).
  160dcg_body_(!, P0, _, S, SR, (!, SR = S), P) :-
  161    !,
  162    dcg_hashswi:dcg_cut_pos(P0, P).
  163dcg_body_({}, P, _, S, S, true, P) :- !.
  164dcg_body_({T}, P0, Q, S, SR, (QT, SR = S), P) :-
  165    !,
  166    dcg_hashswi:dcg_bt_pos(P0, P1),
  167    dcg_hashswi:qualify(Q, T, P1, QT, P).
  168dcg_body_((T,R), P0, Q, S, SR, (Tt, Rt), P) :-
  169    !,
  170    dcg_hashswi:f2_pos(P0, PA0, PB0, P, PA, PB),
  171    dcg_body_(T, PA0, Q, S, SR1, Tt, PA),
  172    dcg_body_(R, PB0, Q, SR1, SR, Rt, PB).
  173dcg_body_((T;R), P0, Q, S, SR, (Tt;Rt), P) :-
  174    !,
  175    dcg_hashswi:f2_pos(P0, PA0, PB0, P, PA, PB),
  176    dcg_body_(T, PA0, Q, S, S1, T1, PA), dcg_hashswi:or_delay_bind(S, SR, S1, T1, Tt),
  177    dcg_body_(R, PB0, Q, S, S2, R1, PB), dcg_hashswi:or_delay_bind(S, SR, S2, R1, Rt).
  178dcg_body_((T|R), P0, Q, S, SR, (Tt;Rt), P) :-
  179    !,
  180    dcg_hashswi:f2_pos(P0, PA0, PB0, P, PA, PB),
  181    dcg_body_(T, PA0, Q, S, S1, T1, PA), dcg_hashswi:or_delay_bind(S, SR, S1, T1, Tt),
  182    dcg_body_(R, PB0, Q, S, S2, R1, PB), dcg_hashswi:or_delay_bind(S, SR, S2, R1, Rt).
  183dcg_body_((C->T), P0, Q, S, SR, (Ct->Tt), P) :-
  184    !,
  185    dcg_hashswi:f2_pos(P0, PA0, PB0, P, PA, PB),
  186    dcg_body_(C, PA0, Q, S, SR1, Ct, PA),
  187    dcg_body_(T, PB0, Q, SR1, SR, Tt, PB).
  188dcg_body_((C*->T), P0, Q, S, SR, (Ct*->Tt), P) :-
  189    !,
  190    dcg_hashswi:f2_pos(P0, PA0, PB0, P, PA, PB),
  191    dcg_body_(C, PA0, Q, S, SR1, Ct, PA),
  192    dcg_body_(T, PB0, Q, SR1, SR, Tt, PB).
  193dcg_body_((\+ C), P0, Q, S, SR, (\+ Ct, SR = S), P) :-
  194    !,
  195    dcg_hashswi:f1_pos(P0, PA0, P, PA),
  196    dcg_body_(C, PA0, Q, S, _, Ct, PA).
  197dcg_body_(T, P0, Q, S, SR, QTt, P) :-
  198    dcg_extend_(T, P0, S, SR, Tt, P1),
  199    dcg_hashswi:qualify(Q, Tt, P1, QTt, P).
  200
  201or_delay_bind(S, SR, S1, T, (T, SR=S)) :-
  202    S1 == S,
  203    !.
  204or_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.

  212qualify(q(M,C,_), X0, Pos0, X, Pos) :-
  213    M == C,
  214    !,
  215    X = X0,
  216    Pos = Pos0.
  217qualify(q(M,_,MP), X, Pos0, M:X, Pos) :-
  218    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.

  228%:- dynamic  dcg_extend_cache/4.
  229%:- volatile dcg_extend_cache/4.
  230
  231dcg_no_extend([]).
  232dcg_no_extend([_|_]).
  233dcg_no_extend({_}).
  234dcg_no_extend({}).
  235dcg_no_extend(!).
  236dcg_no_extend((\+_)).
  237dcg_no_extend((_,_)).
  238dcg_no_extend((_;_)).
  239dcg_no_extend((_|_)).
  240dcg_no_extend((_->_)).
  241dcg_no_extend((_*->_)).
  242dcg_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.

  251/*
  252	'$dcg':dcg_extend/6 without caching
  253	
  254	Original: http://www.swi-prolog.org/pldoc/doc/_SWI_/boot/dcg.pl?show=src#dcg_extend/4
  255	
  256	The built-in caching stores extended bodies in 'dcg_extend_cache/4' facts. 
  257	Was disabled since it caused the expansion inside dcg_tracer:phrase_mi/4 to behave faulty. 
  258*/
  259dcg_extend_(V, _, _, _, _, _) :-
  260	var(V),
  261	!,
  262	throw(error(instantiation_error,_)).
  263dcg_extend_(M:OldT, Pos0, A1, A2, M:NewT, Pos) :-
  264	!,
  265	dcg_hashswi:f2_pos(Pos0, MPos, P0, Pos, MPos, P),
  266	dcg_extend_(OldT, P0, A1, A2, NewT, P).
  267%dcg_extend(OldT, P0, A1, A2, NewT, P) :-
  268%    dcg_extend_cache(OldT, A1, A2, NewT),
  269%    !,
  270%    extended_pos(P0, P).
  271dcg_extend_(OldT, P0, A1, A2, NewT, P) :-
  272	(   callable(OldT)
  273	->  true
  274	;   throw(error(type_error(callable,OldT),_))
  275	),
  276	(   dcg_hashswi:dcg_no_extend(OldT)
  277	->  throw(error(permission_error(define,dcg_nonterminal,OldT),_))
  278	;   true
  279	),
  280	(   compound(OldT)
  281	->  compound_name_arity(OldT, Name, Arity),
  282		compound_name_arity(CopT, Name, Arity)
  283	;   CopT = OldT,
  284		Name = OldT,
  285		Arity = 0
  286	),
  287	NewArity is Arity+2,
  288	functor(NewT, Name, NewArity),
  289	dcg_hashswi:copy_args(1, Arity, CopT, NewT),
  290	A1Pos is Arity+1,
  291	A2Pos is Arity+2,
  292	arg(A1Pos, NewT, A1C),
  293	arg(A2Pos, NewT, A2C),
  294	%assert(dcg_extend_cache(CopT, A1C, A2C, NewT)),
  295	OldT = CopT,
  296	A1C = A1,
  297	A2C = A2,
  298	dcg_hashswi:extended_pos(P0, P).
  299
  300copy_args(I, Arity, Old, New) :-
  301    I =< Arity,
  302    !,
  303    arg(I, Old, A),
  304    arg(I, New, A),
  305    I2 is I + 1,
  306    copy_args(I2, Arity, Old, New).
  307copy_args(_, _, _, _).
  308
  309
  310                 /*******************************
  311                 *        POSITION LOGIC        *
  312                 *******************************/
  313
  314extended_pos(Pos0, Pos) :-
  315    '$expand':extended_pos(Pos0, 2, Pos).
  316f2_pos(Pos0, A0, B0, Pos, A, B) :- '$expand':f2_pos(Pos0, A0, B0, Pos, A, B).
  317f1_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).

  323dcg_bt_pos(Var, Var) :-
  324    var(Var),
  325    !.
  326dcg_bt_pos(brace_term_position(F,T,P0),
  327           term_position(F,T,F,F,
  328                         [ P0,
  329                           term_position(T,T,T,T,_)
  330                         ])) :- !.
  331dcg_bt_pos(Pos, _) :-
  332    expected_layout(brace_term, Pos).
  333
  334dcg_cut_pos(Var, Var) :-
  335    var(Var),
  336    !.
  337dcg_cut_pos(F-T, term_position(F,T,F,T,
  338                               [ F-T,
  339                                 term_position(T,T,T,T,_)
  340                               ])).
  341dcg_cut_pos(Pos, _) :-
  342    expected_layout(atomic, Pos).

 dcg_terminal_pos(+ListPos, -TermPos)

  346dcg_terminal_pos(Pos, _) :-
  347    var(Pos),
  348    !.
  349dcg_terminal_pos(list_position(F,T,_Elms,_Tail),
  350                 term_position(F,T,_,_,_)).
  351dcg_terminal_pos(F-T,
  352                 term_position(F,T,_,_,_)).
  353dcg_terminal_pos(Pos, _) :-
  354    expected_layout(terminal, Pos).

 dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)

  358dcg_qualify_pos(Var, _, _) :-
  359    var(Var),
  360    !.
  361dcg_qualify_pos(Pos,
  362                term_position(F,T,FF,FT,[MP,_]),
  363                term_position(F,T,FF,FT,[MP,Pos])) :- !.
  364dcg_qualify_pos(_, Pos, _) :-
  365    expected_layout(f2, Pos).
  366
  367expected_layout(Expected, Found) :-
  368    '$expand':expected_layout(Expected, Found)