kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/boot/bags.pl

@@ -0,0 +1,283 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  1985-2020, University of Amsterdam,
+                              VU University Amsterdam
+                              CWI, Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+Copyright notes: findall/3, bagof/3 and setof/3 are part of the standard
+folklore of Prolog. The core  is  findall/3   based  on  C code that was
+written for SWI-Prolog. Older versions also used C-based implementations
+of  bagof/3  and  setof/3.  As   these    proved   wrong,   the  current
+implementation is modelled  after  an  older   version  of  Yap.  Ulrich
+Neumerkel fixed the variable preservation of   bagof/3 and setof/3 using
+an algorithm also found in  Yap  6.3,   where  it  is claimed: "uses the
+SICStus algorithm to guarantee that variables will have the same names".
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module('$bags',
+          [ findall/3,                  % +Templ, :Goal, -List
+            findall/4,                  % +Templ, :Goal, -List, +Tail
+            findnsols/4,                % +Count, +Templ, :Goal, -List
+            findnsols/5,                % +Count, +Templ, :Goal, -List, +Tail
+            bagof/3,                    % +Templ, :Goal, -List
+            setof/3                     % +Templ, :Goal, -List
+          ]).
+
+:- meta_predicate
+    findall(?, 0, -),
+    findall(?, 0, -, ?),
+    findnsols(+, ?, 0, -),
+    findnsols(+, ?, 0, -, ?),
+    bagof(?, ^, -),
+    setof(?, ^, -),
+    cleanup_bag(0, 0).
+
+:- noprofile((
+       findall/4,
+       findall/3,
+       findnsols/4,
+       findnsols/5,
+       bagof/3,
+       setof/3,
+       cleanup_bag/2,
+       findall_loop/4)).
+
+:- '$iso'((findall/3,
+           bagof/3,
+           setof/3)).
+
+%!  findall(-Var, +Goal, -Bag) is det.
+%!  findall(-Var, +Goal, -Bag, +Tail) is det.
+%
+%   Bag holds all alternatives for Var  in  Goal.   Bag  might  hold
+%   duplicates.   Equivalent  to bagof, using the existence operator
+%   (^) on all free variables of Goal.  Succeeds with Bag  =  []  if
+%   Goal fails immediately.
+%
+%   The  findall/4  variation  is  a    difference-list  version  of
+%   findall/3.
+
+findall(Templ, Goal, List) :-
+    findall(Templ, Goal, List, []).
+
+findall(Templ, Goal, List, Tail) :-
+    cleanup_bag(
+        findall_loop(Templ, Goal, List, Tail),
+        '$destroy_findall_bag').
+
+%!  cleanup_bag(:Goal, :Cleanup)
+%
+%   Variant  of  setup_call_cleanup/3  that  using  '$new_findall_bag'/0
+%   directly instead of through sig_atomic/1.
+
+cleanup_bag(_Goal, _Cleanup) :-
+    '$new_findall_bag',
+    '$call_cleanup'.
+
+findall_loop(Templ, Goal, List, Tail) :-
+    (   Goal,
+        '$add_findall_bag'(Templ)   % fails
+    ;   '$collect_findall_bag'(List, Tail)
+    ).
+
+%!  findnsols(+Count, @Template, :Goal, -List) is nondet.
+%!  findnsols(+Count, @Template, :Goal, -List, ?Tail) is nondet.
+%
+%   True when List is the next chunk of maximal Count instantiations
+%   of Template that reprensents a solution of Goal.  For example:
+%
+%     ==
+%     ?- findnsols(5, I, between(1, 12, I), L).
+%     L = [1, 2, 3, 4, 5] ;
+%     L = [6, 7, 8, 9, 10] ;
+%     L = [11, 12].
+%     ==
+%
+%   @compat Ciao, but the SWI-Prolog version is non-deterministic.
+%   @error  domain_error(not_less_than_zero, Count) if Count is less
+%           than 0.
+%   @error  type_error(integer, Count) if Count is not an integer.
+
+findnsols(Count, Template, Goal, List) :-
+    findnsols(Count, Template, Goal, List, []).
+
+findnsols(Count, Template, Goal, List, Tail) :-
+    integer(Count),
+    !,
+    findnsols2(count(Count), Template, Goal, List, Tail).
+findnsols(Count, Template, Goal, List, Tail) :-
+    Count = count(Integer),
+    integer(Integer),
+    !,
+    findnsols2(Count, Template, Goal, List, Tail).
+findnsols(Count, _, _, _, _) :-
+    '$type_error'(integer, Count).
+
+findnsols2(Count, Template, Goal, List, Tail) :-
+    nsols_count(Count, N), N > 0,
+    !,
+    copy_term(Template+Goal, Templ+G),
+    setup_call_cleanup(
+        '$new_findall_bag',
+        findnsols_loop(Count, Templ, G, List, Tail),
+        '$destroy_findall_bag').
+findnsols2(Count, _, _, List, Tail) :-
+    nsols_count(Count, 0),
+    !,
+    Tail = List.
+findnsols2(Count, _, _, _, _) :-
+    nsols_count(Count, N),
+    '$domain_error'(not_less_than_zero, N).
+
+findnsols_loop(Count, Templ, Goal, List, Tail) :-
+    nsols_count(Count, FirstStop),
+    State = state(FirstStop),
+    (   call_cleanup(Goal, Det=true),
+        '$add_findall_bag'(Templ, Found),
+        Det \== true,
+        arg(1, State, Found),
+        '$collect_findall_bag'(List, Tail),
+        (   '$suspend_findall_bag'
+        ;   nsols_count(Count, Incr),
+            NextStop is Found+Incr,
+            nb_setarg(1, State, NextStop),
+            fail
+        )
+    ;   '$collect_findall_bag'(List, Tail)
+    ).
+
+nsols_count(count(N), N).
+
+%!  bagof(+Var, +Goal, -Bag) is semidet.
+%
+%   Implements Clocksin and  Melish's  bagof/3   predicate.  Bag  is
+%   unified with the alternatives of Var  in Goal, Free variables of
+%   Goal are bound,  unless  asked  not   to  with  the  existential
+%   quantifier operator (^).
+
+bagof(Templ, Goal0, List) :-
+    '$free_variable_set'(Templ^Goal0, Goal, Vars),
+    (   Vars == v
+    ->  findall(Templ, Goal, List),
+        List \== []
+    ;   alloc_bind_key_list(Vars, VDict),
+        findall(Vars-Templ, Goal, Answers),
+        bind_bagof_keys(Answers, VDict),
+        keysort(Answers, Sorted),
+        pick(Sorted, Vars, List)
+    ).
+
+%!  alloc_bind_key_list(+Vars, -VDict) is det.
+%
+%   Pre-allocate the variable dictionary used   by bind_bagof_keys/2. By
+%   pre-allocating this list all variables  bound become references from
+%   the `Vars` of  each  answer  to  this   dictionary.  If  we  do  not
+%   preallocate we create a huge reference chain from VDict through each
+%   of the answers, causing serious slowdown in the subsequent keysort.
+%
+%   The slowdown was discovered by Jan Burse.
+
+alloc_bind_key_list(Vars, VDict) :-
+    functor(Vars, _, Count),
+    length(List, Count),
+    '$append'(List, _, VDict).
+
+%!  bind_bagof_keys(+VarsTemplPairs, -SharedVars)
+%
+%   Establish a canonical binding  of   the  _vars_ structures. This
+%   code   was   added    by    Ulrich     Neumerkel    in    commit
+%   1bf9e87900b3bbd61308e80a784224c856854745.
+
+bind_bagof_keys([], _).
+bind_bagof_keys([W-_|WTs], Vars) :-
+    term_variables(W, Vars, _),
+    bind_bagof_keys(WTs, Vars).
+
+pick(Bags, Vars1, Bag1) :-
+    pick_first(Bags, Vars0, Bag0, RestBags),
+    select_bag(RestBags, Vars0, Bag0, Vars1, Bag1).
+
+select_bag([], Vars0, Bag0, Vars1, Bag1) :-   % last one: deterministic
+    !,
+    Vars0 = Vars1,
+    Bag0 = Bag1.
+select_bag(_, Vars, Bag, Vars, Bag).
+select_bag(RestBags, _, _, Vars1, Bag1) :-
+    pick(RestBags, Vars1, Bag1).
+
+%!  pick_first(+Bags, +Vars, -Bag1, -RestBags) is semidet.
+%
+%   Pick the first result-bag from the   list  of Templ-Answer. Note
+%   that we pick all elements that are  equal under =@=, but because
+%   the variables in the witness are canonized this is the same as ==.
+%
+%   @param Bags     List of Templ-Answer
+%   @param Vars     Initial Templ (for rebinding variables)
+%   @param Bag1     First bag of results
+%   @param RestBags Remaining Templ-Answer
+
+pick_first([Vars-Templ|T0], Vars, [Templ|T], RestBag) :-
+    pick_same(T0, Vars, T, RestBag).
+
+
+pick_same([V-H|T0], Vars, [H|T], Bag) :-
+    V == Vars,
+    !,
+    pick_same(T0, Vars, T, Bag).
+pick_same(Bag, _, [], Bag).
+
+
+%!  setof(+Var, +Goal, -Set) is semidet.
+%
+%   Equivalent to bagof/3, but sorts the   resulting bag and removes
+%   duplicate answers. We sort  immediately   after  the  findall/3,
+%   removing duplicate Templ-Answer pairs early.
+
+setof(Templ, Goal0, List) :-
+    '$free_variable_set'(Templ^Goal0, Goal, Vars),
+    (   Vars == v
+    ->  findall(Templ, Goal, Answers),
+        Answers \== [],
+        sort(Answers, List)
+    ;   alloc_bind_key_list(Vars, VDict),
+        findall(Vars-Templ, Goal, Answers),
+        (   ground(Answers)
+        ->  sort(Answers, Sorted),
+            pick(Sorted, Vars, List)
+        ;   bind_bagof_keys(Answers, VDict),
+            sort(Answers, Sorted),
+            pick(Sorted, Vars, Listu),
+            sort(Listu, List) % Listu ordering may be nixed by Vars
+        )
+    ).

package/lib/swipl/boot/dcg.pl

@@ -0,0 +1,388 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2009-2025, University of Amsterdam
+                              VU University Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module('$dcg',
+          [ dcg_translate_rule/2,       % +Rule, -Clause
+            dcg_translate_rule/4,       % +Rule, ?Pos0, -Clause, -Pos
+            phrase/2,                   % :Rule, ?Input
+            phrase/3,                   % :Rule, ?Input, ?Rest
+            call_dcg/3                  % :Rule, ?State0, ?State
+          ]).
+
+/** <module> Grammar rule (DCG) compiler
+
+This module provides the  term-expansion  rules   for  DCGs  as  well as
+phrase/2,3 and call_dcg/3 for calling DCGs. The original code was copied
+from C-Prolog and written by Fernando  Pereira, EDCAAD, Edinburgh, 1984.
+Since then many people have modified and extended this code.
+
+DCGs have for a long time been a moving target, notably when it comes to
+dealing with cuts and unification delaying   for  calls to non-DCG code.
+This has slowly converged. This implementation   attempts  to be closely
+compatible to the pending ISO standard for DCGs.
+*/
+
+dcg_translate_rule(Rule, Clause) :-
+    dcg_translate_rule(Rule, _, Clause, _).
+
+dcg_translate_rule((LP,MNT-->RP), Pos0, Clause, Pos) =>
+    Clause = (H:-B0,B1),
+    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
+    f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
+    '$current_source_module'(M),
+    Qualify = q(M,M,_),
+    dcg_extend(LP, PosLP0, S0, SR, H, PosLP),
+    dcg_body(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
+    dcg_body(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT).
+dcg_translate_rule((LP-->RP), Pos0, Clause, Pos) =>
+    Clause = (H:-B),
+    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
+    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
+    '$current_source_module'(M),
+    Qualify = q(M,M,_),
+    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
+dcg_translate_rule((LP,MNT==>RP), Pos0, Clause, Pos), is_list(MNT) =>
+    Clause = (H=>B0,B1),
+    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
+    f2_pos(PosH0, PosLP0, PosMNT0, PosH, PosLP, PosMNT),
+    '$current_source_module'(M),
+    Qualify = q(M,M,_),
+    dcg_extend(LP, PosLP0, S0, SR, H, PosLP),
+    dcg_body(RP, PosRP0, Qualify, S0, S1, B0, PosRP),
+    dcg_body(MNT, PosMNT0, Qualify, SR, S1, B1, PosMNT).
+dcg_translate_rule((LP,Grd==>RP), Pos0, Clause, Pos) =>
+    Clause = (H,Grd=>B),
+    f2_pos(Pos0, PosH0, PosRP0, Pos, PosH, PosRP),
+    f2_pos(PosH0, PosLP0, PosGrd, PosH, PosLP, PosGrd),
+    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
+    '$current_source_module'(M),
+    Qualify = q(M,M,_),
+    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
+dcg_translate_rule((LP==>RP), Pos0, Clause, Pos) =>
+    Clause = (H=>B),
+    f2_pos(Pos0, PosLP0, PosRP0, Pos, PosLP, PosRP),
+    dcg_extend(LP, PosLP0, S0, S, H, PosLP),
+    '$current_source_module'(M),
+    Qualify = q(M,M,_),
+    dcg_body(RP, PosRP0, Qualify, S0, S, B, PosRP).
+
+%!  dcg_body(:DCG, ?Pos0, +Qualify, ?List, ?Tail, -Goal, -Pos) is det.
+%
+%   Translate DCG body term.
+
+dcg_body(Var, P0, Q, S, SR, phrase(QVar, S, SR), P) :-
+    var(Var),
+    !,
+    qualify(Q, Var, P0, QVar, P).
+dcg_body(M:X, Pos0, q(_,C,_), S, SR, Ct, Pos) :-
+    !,
+    f2_pos(Pos0, _, XP0, _, _, _),
+    dcg_body(X, XP0, q(M,C,Pos0), S, SR, Ct, Pos).
+dcg_body([], P0, _, S, SR, S=SR, P) :-         % Terminals
+    !,
+    dcg_terminal_pos(P0, P).
+dcg_body(List, P0, _, S, SR, C, P) :-
+    (   List = [_|_]
+    ->  !,
+        (   is_list(List)
+        ->  '$append'(List, SR, OL),        % open the list
+            C = (S = OL)
+        ;   '$type_error'(list, List)
+        )
+    ;   string(List)                        % double_quotes = string
+    ->  !,
+        string_codes(List, Codes),
+        '$append'(Codes, SR, OL),
+        C = (S = OL)
+    ),
+    dcg_terminal_pos(P0, P).
+dcg_body(!, P0, _, S, SR, (!, SR = S), P) :-
+    !,
+    dcg_cut_pos(P0, P).
+dcg_body({}, P, _, S, S, true, P) :- !.
+dcg_body({T}, P0, Q, S, SR, (QT, SR = S), P) :-
+    !,
+    dcg_bt_pos(P0, P1),
+    qualify(Q, T, P1, QT, P).
+dcg_body((T,R), P0, Q, S, SR, (Tt, Rt), P) :-
+    !,
+    f2_pos(P0, PA0, PB0, P, PA, PB),
+    dcg_body(T, PA0, Q, S, SR1, Tt, PA),
+    dcg_body(R, PB0, Q, SR1, SR, Rt, PB).
+dcg_body((T;R), P0, Q, S, SR, (Tt;Rt), P) :-
+    !,
+    f2_pos(P0, PA0, PB0, P, PA, PB),
+    dcg_body(T, PA0, Q, S, S1, T1, PA), or_delay_bind(S, SR, S1, T1, Tt),
+    dcg_body(R, PB0, Q, S, S2, R1, PB), or_delay_bind(S, SR, S2, R1, Rt).
+dcg_body((T|R), P0, Q, S, SR, (Tt;Rt), P) :-
+    !,
+    f2_pos(P0, PA0, PB0, P, PA, PB),
+    dcg_body(T, PA0, Q, S, S1, T1, PA), or_delay_bind(S, SR, S1, T1, Tt),
+    dcg_body(R, PB0, Q, S, S2, R1, PB), or_delay_bind(S, SR, S2, R1, Rt).
+dcg_body((C->T), P0, Q, S, SR, (Ct->Tt), P) :-
+    !,
+    f2_pos(P0, PA0, PB0, P, PA, PB),
+    dcg_body(C, PA0, Q, S, SR1, Ct, PA),
+    dcg_body(T, PB0, Q, SR1, SR, Tt, PB).
+dcg_body((C*->T), P0, Q, S, SR, (Ct*->Tt), P) :-
+    !,
+    f2_pos(P0, PA0, PB0, P, PA, PB),
+    dcg_body(C, PA0, Q, S, SR1, Ct, PA),
+    dcg_body(T, PB0, Q, SR1, SR, Tt, PB).
+dcg_body((\+ C), P0, Q, S, SR, (\+ Ct, SR = S), P) :-
+    !,
+    f1_pos(P0, PA0, P, PA),
+    dcg_body(C, PA0, Q, S, _, Ct, PA).
+dcg_body(T, P0, Q, S, SR, QTt, P) :-
+    dcg_extend(T, P0, S, SR, Tt, P1),
+    qualify(Q, Tt, P1, QTt, P).
+
+or_delay_bind(S, SR, S1, T, (T, SR=S)) :-
+    S1 == S,
+    !.
+or_delay_bind(_S, SR, SR, T, T).
+
+%!  qualify(+QualifyInfo, +Goal, +Pos0, -QGoal, -Pos) is det.
+%
+%   @arg 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.
+
+qualify(q(M,C,_), X0, Pos0, X, Pos) :-
+    M == C,
+    !,
+    X = X0,
+    Pos = Pos0.
+qualify(q(M,_,MP), X, Pos0, M:X, Pos) :-
+    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.
+
+:- dynamic  dcg_extend_cache/4.
+:- volatile dcg_extend_cache/4.
+
+dcg_no_extend([]).
+dcg_no_extend([_|_]).
+dcg_no_extend({_}).
+dcg_no_extend({}).
+dcg_no_extend(!).
+dcg_no_extend((\+_)).
+dcg_no_extend((_,_)).
+dcg_no_extend((_;_)).
+dcg_no_extend((_|_)).
+dcg_no_extend((_->_)).
+dcg_no_extend((_*->_)).
+dcg_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.
+
+dcg_extend(V, _, _, _, _, _) :-
+    var(V),
+    !,
+    throw(error(instantiation_error,_)).
+dcg_extend(M:OldT, Pos0, A1, A2, M:NewT, Pos) :-
+    !,
+    f2_pos(Pos0, MPos, P0, Pos, MPos, P),
+    dcg_extend(OldT, P0, A1, A2, NewT, P).
+dcg_extend(OldT, P0, A1, A2, NewT, P) :-
+    dcg_extend_cache(OldT, A1, A2, NewT),
+    !,
+    extended_pos(P0, P).
+dcg_extend(OldT, P0, A1, A2, NewT, P) :-
+    (   callable(OldT)
+    ->  true
+    ;   throw(error(type_error(callable,OldT),_))
+    ),
+    (   dcg_no_extend(OldT)
+    ->  throw(error(permission_error(define,dcg_nonterminal,OldT),_))
+    ;   true
+    ),
+    (   compound(OldT)
+    ->  compound_name_arity(OldT, Name, Arity),
+        compound_name_arity(CopT, Name, Arity)
+    ;   CopT = OldT,
+        Name = OldT,
+        Arity = 0
+    ),
+    NewArity is Arity+2,
+    functor(NewT, Name, NewArity),
+    copy_args(1, Arity, CopT, NewT),
+    A1Pos is Arity+1,
+    A2Pos is Arity+2,
+    arg(A1Pos, NewT, A1C),
+    arg(A2Pos, NewT, A2C),
+    assert(dcg_extend_cache(CopT, A1C, A2C, NewT)),
+    OldT = CopT,
+    A1C = A1,
+    A2C = A2,
+    extended_pos(P0, P).
+
+copy_args(I, Arity, Old, New) :-
+    I =< Arity,
+    !,
+    arg(I, Old, A),
+    arg(I, New, A),
+    I2 is I + 1,
+    copy_args(I2, Arity, Old, New).
+copy_args(_, _, _, _).
+
+
+                 /*******************************
+                 *        POSITION LOGIC        *
+                 *******************************/
+
+extended_pos(Pos0, Pos) :-
+    '$expand':extended_pos(Pos0, 2, Pos).
+f2_pos(Pos0, A0, B0, Pos, A, B) :- '$expand':f2_pos(Pos0, A0, B0, Pos, A, B).
+f1_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).
+
+dcg_bt_pos(Var, Var) :-
+    var(Var),
+    !.
+dcg_bt_pos(brace_term_position(F,T,P0),
+           term_position(F,T,F,F,
+                         [ P0,
+                           term_position(T,T,T,T,_)
+                         ])) :- !.
+dcg_bt_pos(Pos, _) :-
+    expected_layout(brace_term, Pos).
+
+dcg_cut_pos(Var, Var) :-
+    var(Var),
+    !.
+dcg_cut_pos(F-T, term_position(F,T,F,T,
+                               [ F-T,
+                                 term_position(T,T,T,T,_)
+                               ])).
+dcg_cut_pos(Pos, _) :-
+    expected_layout(atomic, Pos).
+
+%!  dcg_terminal_pos(+ListPos, -TermPos)
+
+dcg_terminal_pos(Pos, _) :-
+    var(Pos),
+    !.
+dcg_terminal_pos(list_position(F,T,_Elms,_Tail),
+                 term_position(F,T,_,_,_)).
+dcg_terminal_pos(F-T,
+                 term_position(F,T,_,_,_)).
+dcg_terminal_pos(string_position(F,T),
+                 term_position(F,T,_,_,_)).
+dcg_terminal_pos(Pos, _) :-
+    expected_layout(terminal, Pos).
+
+%!  dcg_qualify_pos(?TermPos0, ?ModuleCreatingPos, -TermPos)
+
+dcg_qualify_pos(Var, _, _) :-
+    var(Var),
+    !.
+dcg_qualify_pos(Pos,
+                term_position(F,T,FF,FT,[MP,_]),
+                term_position(F,T,FF,FT,[MP,Pos])) :- !.
+dcg_qualify_pos(_, Pos, _) :-
+    expected_layout(f2, Pos).
+
+expected_layout(Expected, Found) :-
+    '$expand':expected_layout(Expected, Found).
+
+
+                 /*******************************
+                 *       PHRASE INTERFACE       *
+                 *******************************/
+
+%!  phrase(:RuleSet, ?List).
+%!  phrase(:RuleSet, ?List, ?Rest).
+%
+%   Interface to DCGs
+
+:- meta_predicate
+    phrase(//, ?),
+    phrase(//, ?, ?),
+    call_dcg(//, ?, ?).
+:- noprofile((phrase/2,
+              phrase/3,
+              call_dcg/3)).
+:- '$iso'((phrase/2, phrase/3)).
+
+phrase(RuleSet, Input) :-
+    phrase(RuleSet, Input, []).
+phrase(RuleSet, Input, Rest) :-
+    phrase_input(Input),
+    phrase_input(Rest),
+    call_dcg(RuleSet, Input, Rest).
+
+call_dcg(RuleSet, Input, Rest) :-
+    (   strip_module(RuleSet, M, Plain),
+        nonvar(Plain),
+        dcg_special(Plain)
+    ->  dcg_body(Plain, _, q(M,M,_), S0, S, Body, _),
+        Input = S0, Rest = S,
+        call(M:Body)
+    ;   call(RuleSet, Input, Rest)
+    ).
+
+phrase_input(Var) :- var(Var), !.
+phrase_input([_|_]) :- !.
+phrase_input([]) :- !.
+phrase_input(Data) :-
+    throw(error(type_error(list, Data), _)).
+
+dcg_special(S) :-
+    string(S).
+dcg_special((_,_)).
+dcg_special((_;_)).
+dcg_special((_|_)).
+dcg_special((_->_)).
+dcg_special(!).
+dcg_special({_}).
+dcg_special([]).
+dcg_special([_|_]).
+dcg_special(\+_).