implement DCGs using the logical expansion of the draft proposal

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "scryer-prolog"
-version = "0.8.101"
+version = "0.8.102"
 authors = ["Mark Thom <markjordanthom@gmail.com>"]
 build = "build.rs"
 repository = "https://github.com/mthom/scryer-prolog"

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) :-
+user:term_expansion(Term0, (Head :- Body)) :-
-    nonvar(G), G = [_|_], !.
+    dcg_rule(Term0, Term),
-phrase(G, Ls0) :-
+    Term = (Head :- Body0),
-    nonvar(G), G = (G1, G2), !, phrase(G1, Ls0, Ls1), phrase(G2, Ls1, []).
+    unravel_commas(Body0, Body).
-phrase(G, Ls0) :-
-    nonvar(G), G == !, !, Ls0 = [].
-phrase(G, Ls0) :-
-    call(G, Ls0, []).
 
-phrase(G, Ls0, Ls1) :-
+unravel_commas(((A, B), C), Body) :-
-    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).
-
-user:term_expansion(Term0, Term) :-
-    numbervars(Term0, 0, N),
-    expand_dcgs(Term0, N, Term).
-
-expand_dcgs(Term0, N, (ModHead :- ModBody)) :-
-    nonvar(Term0),
-    Term0 = (Head, [SC | SCs] --> Body),
     !,
-    nonvar(Head),
+    unravel_commas((B, C), Body0),
-    Head =.. [RuleName | Args],
+    unravel_commas((A, Body0), Body).
-    append([SC | SCs], '$VAR'(N1), SemiContextArgs),
+unravel_commas((A, B), (A, Body0)) :-
-    append(Args, ['$VAR'(N), SemiContextArgs], ModArgs),
+    !, unravel_commas(B, Body0).
-    ModHead =.. [RuleName | ModArgs],
+unravel_commas(Body, Body).
-    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).
 
-expand_body(Term0, ModTerms, N0, N) :-
+phrase(GRBody, S0) :-
-    nonvar(Term0), Term0 = (Term, Terms), !,
+    phrase(GRBody, S0, []).
-    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).
 
-/* unfurl_commas(?ModTerm, -ModTerms, -ModTerms1) :
+phrase(GRBody, S0, S) :-
-   sets  ModTerms = (ModTermI0, ModTermI1, ..., ModTermIN, ModTerms1)
+    (  var(GRBody) -> throw(error(instantiation_error, phrase/3))
-   where ModTerm  = (ModTermI0, ModTermI1, ..., ModTermIN) */
+    ;  dcg_constr(GRBody) -> phrase_(GRBody, S0, S)
-unfurl_commas(ModTerm, ModTerms, ModTerms1) :-
+    ;  functor(GRBody, _, _) -> call(GRBody, S0, S)
-    nonvar(ModTerm),
+    ;  throw(error(type_error(callable, GRBody), phrase/3))
-    ModTerm  = (ModTermI0, ModTermIs),
-    !,
-    ModTerms = (ModTermI0, ModTerms2),
-    unfurl_commas(ModTermIs, ModTerms2, ModTerms1).
-unfurl_commas(ModTermIN, (ModTermIN, ModTerms1), ModTerms1).
-
-unfurl_cond((P -> Q0), (P -> Q), Hole) :-
-    !, unfurl_commas(Q0, Q, Hole).
-unfurl_cond(P, Q, Hole) :-
-    unfurl_commas(P, Q, Hole).
-
-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].
 
-comma_ify([Term], Term) :- !.
+phrase_([], S, S).
-comma_ify([Term | Args], (Term, Terms)) :-
+phrase_(!, S, S).
-    comma_ify(Args, Terms).
+phrase_((A, B), S0, S) :-
+    phrase(A, S0, S1), phrase(B, S1, S).
+phrase_((A -> B ; C), S0, S) :-
+    !,
+    (  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).
+
+% 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).
+
+dcg_non_terminal(NonTerminal, S0, S, Goal) :-
+    NonTerminal =.. NonTerminalUniv,
+    append(NonTerminalUniv, [S0, S], GoalUniv),
+    Goal =.. GoalUniv.
+
+dcg_terminals(Terminals, S0, S, S0 = List) :-
+    append(Terminals, S, List).
+
+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.)
+
+% 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).

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) =>

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) ->