implement DCGs using the logical expansion of the draft proposal

diff --git a/Cargo.toml b/Cargo.toml
index 840f8b00056ecb724f2ad0655b898cef5fa6b8a9..ba5d76cf06f8eb7a89bfc9d606ba8667731637f9 100644 (file)
--- a/Cargo.toml
+++ b/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "scryer-prolog"
-version = "0.8.101"
+version = "0.8.102"
 authors = ["Mark Thom <[email protected]>"]
 build = "build.rs"
 repository = "https://github.com/mthom/scryer-prolog"

diff --git a/src/prolog/lib/dcgs.pl b/src/prolog/lib/dcgs.pl
index 9bad9df447bc2e4d8e09b7c3ecb921e40750b7b1..3f9b3f249c97a49b52ac374e08bb30ca109cc648 100644 (file)
--- a/src/prolog/lib/dcgs.pl
+++ b/src/prolog/lib/dcgs.pl
@@ -1,115 +1,130 @@
 :- op(1200, xfx, -->).
+% :- op(1105, xfy, ('|')).
 
 :- module(dcgs, [phrase/2, phrase/3]).
 
 :- use_module(library(lists), [append/3]).
-:- use_module(library(terms)).
 
-phrase(G, G) :-
-    nonvar(G), G = [_|_], !.
-phrase(G, Ls0) :-
-    nonvar(G), G = (G1, G2), !, phrase(G1, Ls0, Ls1), phrase(G2, Ls1, []).
-phrase(G, Ls0) :-
-    nonvar(G), G == !, !, Ls0 = [].
-phrase(G, Ls0) :-
-    call(G, Ls0, []).
+user:term_expansion(Term0, (Head :- Body)) :-
+    dcg_rule(Term0, Term),
+    Term = (Head :- Body0),
+    unravel_commas(Body0, Body).
 
-phrase(G, Ls0, Ls1) :-
-    nonvar(G), G = [_|_], !, append(G, Ls1, Ls0).
-phrase(G, Ls0, Ls2) :-
-    nonvar(G), G = (G1, G2), !,
-    phrase(G1, Ls0, Ls1), phrase(G2, Ls1, Ls2).
-phrase(G, Ls0, Ls1) :-
-    nonvar(G), G == !, !, Ls0 = Ls1.
-phrase(G, Ls0, Ls1) :-
-    call(G, Ls0, Ls1).
+unravel_commas(((A, B), C), Body) :-
+    !,
+    unravel_commas((B, C), Body0),
+    unravel_commas((A, Body0), Body).
+unravel_commas((A, B), (A, Body0)) :-
+    !, unravel_commas(B, Body0).
+unravel_commas(Body, Body).
+
+phrase(GRBody, S0) :-
+    phrase(GRBody, S0, []).
 
-user:term_expansion(Term0, Term) :-
-    numbervars(Term0, 0, N),
-    expand_dcgs(Term0, N, Term).
+phrase(GRBody, S0, S) :-
+    (  var(GRBody) -> throw(error(instantiation_error, phrase/3))
+    ;  dcg_constr(GRBody) -> phrase_(GRBody, S0, S)
+    ;  functor(GRBody, _, _) -> call(GRBody, S0, S)
+    ;  throw(error(type_error(callable, GRBody), phrase/3))
+    ).
 
-expand_dcgs(Term0, N, (ModHead :- ModBody)) :-
-    nonvar(Term0),
-    Term0 = (Head, [SC | SCs] --> Body),
+phrase_([], S, S).
+phrase_(!, S, S).
+phrase_((A, B), S0, S) :-
+    phrase(A, S0, S1), phrase(B, S1, S).
+phrase_((A -> B ; C), S0, S) :-
     !,
-    nonvar(Head),
-    Head =.. [RuleName | Args],
-    append([SC | SCs], '$VAR'(N1), SemiContextArgs),
-    append(Args, ['$VAR'(N), SemiContextArgs], ModArgs),
-    ModHead =.. [RuleName | ModArgs],
-    nonvar(Body),
-    expand_body(Body, ModBody, N, N1).
-expand_dcgs(Term0, N, (ModHead :- ModBody)) :-
-    nonvar(Term0),
-    Term0 = (Head --> Body),
-    nonvar(Head),
-    Head =.. [RuleName | Args],
-    append(Args, ['$VAR'(N), '$VAR'(N1)], ModArgs),
-    ModHead =.. [RuleName | ModArgs],
-    nonvar(Body),
-    expand_body(Body, ModBody, N, N1).
+    (  phrase(A, S0, S1) ->
+       phrase(B, S1, S)
+    ;  phrase(C, S0, S)
+    ).
+phrase_((A ; B), S0, S) :-
+    (  phrase(A, S0, S) ; phrase(B, S0, S)  ).
+%% phrase_((A | B), S0, S) :-
+%%     (  phrase(A, S0, S) ; phrase(B, S0, S)  ).
+phrase_({G}, S0, S) :-
+    (  G, S0 = S  ).
+phrase_(call(G), S0, S) :-
+    call(G, S0, S).
+phrase_((A -> B), S0, S) :-
+    phrase((A -> B ; fail), S0, S).
+phrase_(phrase(NonTerminal), S0, S) :-
+    phrase(NonTerminal, S0, S).
+phrase_([T|Ts], S0, S) :-
+    append([T|Ts], S, S0).
 
-expand_body(Term0, ModTerms, N0, N) :-
-    nonvar(Term0), Term0 = (Term, Terms), !,
-    nonvar(Term),
-    expand_body_term(Term, ModTerm, N0, N1),
-    unfurl_commas(ModTerm, ModTerms, ModTerms1),
-    expand_body(Terms, ModTerms1, N1, N).
-expand_body(Term0, ModTerm, N0, N) :-
-    nonvar(Term0),
-    expand_body_term(Term0, ModTerm, N0, N).
+% This program uses append/3 as defined in the Prolog prologue.
+% Expands a DCG rule into a Prolog rule, when no error condition applies.
+dcg_rule(( NonTerminal, Terminals --> GRBody ), ( Head :- Body )) :-
+    dcg_non_terminal(NonTerminal, S0, S, Head),
+    dcg_body(GRBody, S0, S1, Goal1),
+    dcg_terminals(Terminals, S, S1, Goal2),
+    Body = ( Goal1, Goal2 ).
+dcg_rule(( NonTerminal --> GRBody ), ( Head :- Body )) :-
+    NonTerminal \= ( _, _ ),
+    dcg_non_terminal(NonTerminal, S0, S, Head),
+    dcg_body(GRBody, S0, S, Body).
 
-/* unfurl_commas(?ModTerm, -ModTerms, -ModTerms1) :
-   sets  ModTerms = (ModTermI0, ModTermI1, ..., ModTermIN, ModTerms1)
-   where ModTerm  = (ModTermI0, ModTermI1, ..., ModTermIN) */
-unfurl_commas(ModTerm, ModTerms, ModTerms1) :-
-    nonvar(ModTerm),
-    ModTerm  = (ModTermI0, ModTermIs),
-    !,
-    ModTerms = (ModTermI0, ModTerms2),
-    unfurl_commas(ModTermIs, ModTerms2, ModTerms1).
-unfurl_commas(ModTermIN, (ModTermIN, ModTerms1), ModTerms1).
+dcg_non_terminal(NonTerminal, S0, S, Goal) :-
+    NonTerminal =.. NonTerminalUniv,
+    append(NonTerminalUniv, [S0, S], GoalUniv),
+    Goal =.. GoalUniv.
 
-unfurl_cond((P -> Q0), (P -> Q), Hole) :-
-    !, unfurl_commas(Q0, Q, Hole).
-unfurl_cond(P, Q, Hole) :-
-    unfurl_commas(P, Q, Hole).
+dcg_terminals(Terminals, S0, S, S0 = List) :-
+    append(Terminals, S, List).
 
-expand_body_term([], true, N, N) :- !.
-expand_body_term([Arg|Args], ModTerm, N0, N) :-
-    !, N is N0 + 1,
-    append([Arg|Args], '$VAR'(N), ModArgs),
-    ModTerm = ('$VAR'(N0) = ModArgs).
-expand_body_term((P -> Q), (PModTerm -> QModTerm), N0, N) :-
-    !,
-    expand_body(P, PModTerm, N0, N1),
-    expand_body(Q, QModTerm, N1, N).
-expand_body_term((P ; Q), (PModTerm ; QModTerm), N0, N) :-
-    !,
-    expand_body(P, PModTerm0, N0, N1),
-    expand_body(Q, QModTerm0, N0, N2),
-    ( N1 == N2 -> PModTerm = PModTerm0,
-                 QModTerm = QModTerm0,
-                 N = N1
-    ; N1 < N2  -> unfurl_cond(PModTerm0, PModTerm, Hole),
-                 Hole = ('$VAR'(N1) = '$VAR'(N2) ),
-                 QModTerm = QModTerm0,
-                 N = N2
-    ; N1 > N2  -> unfurl_cond(QModTerm0, QModTerm, Hole),
-                 Hole = ('$VAR'(N1) = '$VAR'(N2) ),
-                 PModTerm = PModTerm0,
-                 N = N1
-    ).
-expand_body_term(!, !, N, N) :- !.
-expand_body_term(CommaTerm, ModTerm, N, N) :-
-    CommaTerm =.. [{} | BodyTerms], !,
-    comma_ify(BodyTerms, ModTerm).
-expand_body_term(GrammarRule, ModTerm, N0, N) :-
-    GrammarRule =.. [Name | Args],
-    N is N0 + 1,
-    append(Args, ['$VAR'(N0), '$VAR'(N)], ModArgs),
-    ModTerm =.. [Name | ModArgs].
+dcg_body(Var, S0, S, Body) :-
+    var(Var),
+    Body = phrase(Var, S0, S).
+dcg_body(GRBody, S0, S, Body) :-
+    nonvar(GRBody),
+    dcg_constr(GRBody),
+    dcg_cbody(GRBody, S0, S, Body).
+dcg_body(NonTerminal, S0, S, Goal) :-
+    nonvar(NonTerminal),
+    \+ dcg_constr(NonTerminal),
+    NonTerminal \= ( _ -> _ ),
+    NonTerminal \= ( \+ _ ),
+    dcg_non_terminal(NonTerminal, S0, S, Goal).
+
+% The following constructs in a grammar rule body
+% are defined in the corresponding subclauses.
+dcg_constr([]). % 7.14.1
+dcg_constr([_|_]). % 7.14.2 - terminal sequence
+dcg_constr(( _, _ )). % 7.14.3 - concatenation
+dcg_constr(( _ ; _ )). % 7.14.4 - alternative
+%% dcg_constr(( _'|'_ )). % 7.14.6 - alternative
+dcg_constr({_}). % 7.14.7
+dcg_constr(call(_)). % 7.14.8
+dcg_constr(phrase(_)). % 7.14.9
+dcg_constr(!). % 7.14.10
+%% dcg_constr(\+ _). % 7.14.11 - not (existence implementation dep.)
+dcg_constr((_->_)). % 7.14.12 - if-then (existence implementation dep.)
 
-comma_ify([Term], Term) :- !.
-comma_ify([Term | Args], (Term, Terms)) :-
-    comma_ify(Args, Terms).
+% The principal functor of the first argument indicates
+% the construct to be expanded.
+dcg_cbody([], S0, S, S0 = S).
+dcg_cbody([T|Ts], S0, S, Goal) :-
+    dcg_terminals([T|Ts], S0, S, Goal).
+dcg_cbody(( GRFirst, GRSecond ), S0, S, ( First, Second )) :-
+    dcg_body(GRFirst, S0, S1, First),
+    dcg_body(GRSecond, S1, S, Second).
+dcg_cbody(( GREither ; GROr ), S0, S, ( Either ; Or )) :-
+    \+ subsumes_term(( _ -> _ ), GREither),
+    dcg_body(GREither, S0, S, Either),
+    dcg_body(GROr, S0, S, Or).
+dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else )) :-
+    subsumes_term(( _GRIf -> _GRThen ), GRCond),
+    dcg_cbody(GRCond, S0, S, Cond),
+    dcg_body(GRElse, S0, S, Else).
+%% dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or )) :-
+%%     dcg_body(GREither, S0, S, Either),
+%%     dcg_body(GROr, S0, S, Or).
+dcg_cbody({Goal}, S0, S, ( Goal, S0 = S )).
+dcg_cbody(call(Cont), S0, S, call(Cont, S0, S)).
+dcg_cbody(phrase(Body), S0, S, phrase(Body, S0, S)).
+dcg_cbody(!, S0, S, ( !, S0 = S )).
+dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody,S0,_), S0 = S )).
+dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
+    dcg_body(GRIf, S0, S1, If),
+    dcg_body(GRThen, S1, S, Then).

diff --git a/src/prolog/machine/toplevel.rs b/src/prolog/machine/toplevel.rs
index 12135a7bbdcd751c9142bd44ecf1aaad74cabba1..f9c7b3e3e9a0515304ba56c97efd1401bcb29efb 100644 (file)
--- a/src/prolog/machine/toplevel.rs
+++ b/src/prolog/machine/toplevel.rs
@@ -143,14 +143,19 @@ pub fn to_op_decl(prec: usize, spec: &str, name: ClauseName) -> Result<OpDecl, P
     }
 }
 
-fn setup_op_decl(mut terms: Vec<Box<Term>>) -> Result<OpDecl, ParserError> {
+fn setup_op_decl(
+    mut terms: Vec<Box<Term>>,
+    atom_tbl: TabledData<Atom>,
+) -> Result<OpDecl, ParserError> {
     let name = match *terms.pop().unwrap() {
         Term::Constant(_, Constant::Atom(name, _)) => name,
+        Term::Constant(_, Constant::Char(c)) => clause_name!(c.to_string(), atom_tbl.clone()),
         _ => return Err(ParserError::InconsistentEntry),
     };
 
     let spec = match *terms.pop().unwrap() {
         Term::Constant(_, Constant::Atom(name, _)) => name,
+        Term::Constant(_, Constant::Char(c)) => clause_name!(c.to_string(), atom_tbl.clone()),
         _ => return Err(ParserError::InconsistentEntry),
     };
 
@@ -434,7 +439,7 @@ fn setup_declaration(
         Term::Clause(_, name, mut terms, _) =>
            match (name.as_str(), terms.len()) {
                ("op", 3) =>
-                   Ok(Declaration::Op(setup_op_decl(terms)?)),
+                   Ok(Declaration::Op(setup_op_decl(terms, indices.local.atom_tbl.clone())?)),
                ("module", 2) =>
                    Ok(Declaration::Module(setup_module_decl(terms)?)),
                ("use_module", 1) =>

diff --git a/src/prolog/toplevel.pl b/src/prolog/toplevel.pl
index d30ba8fed18730e1a3eaa91a320a848d53722637..0277b1a63e5d657a30ccd3cffca5ad2fadd86f86 100644 (file)
--- a/src/prolog/toplevel.pl
+++ b/src/prolog/toplevel.pl
@@ -24,8 +24,11 @@
     '$read_query_term'(Term, VarList),
     '$instruction_match'(Term, VarList).
 
+% make '$compile_batch', a system routine, callable.
+'$$compile_batch' :- '$compile_batch'.
+
 '$instruction_match'([user], []) :-
-    !, '$compile_batch'.
+    !, catch('$$compile_batch', E, '$print_exception_with_check'(E)).
 '$instruction_match'(Term, VarList) :-
     '$submit_query_and_print_results'(Term, VarList),
     !.
@@ -33,7 +36,14 @@
 '$print_exception'(E) :-
     write_term('caught: ', [quoted(false)]),
     writeq(E),
-    nl.    
+    nl.
+
+'$print_exception_with_check'(E) :-
+    (  E = error(_, _:_) -> true % if the error source contains a line
+                                 % number, a GNU-style error message
+                                 % is expected to be printed instead.
+    ;  '$print_exception'(E)
+    ).
 
 '$predicate_indicator'(Source, PI) :-
     (  nonvar(PI) ->