From: Mark Thom Date: Sat, 5 Oct 2019 06:17:57 +0000 (-0600) Subject: implement DCGs using the logical expansion of the draft proposal X-Git-Tag: v0.8.110~15 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=93d1cd1b0989bf70126147afabb972939648fa8d;p=scryer-prolog.git implement DCGs using the logical expansion of the draft proposal --- diff --git a/Cargo.toml b/Cargo.toml index 840f8b00..ba5d76cf 100644 --- 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 "] 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 9bad9df4..3f9b3f24 100644 --- 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 12135a7b..f9c7b3e3 100644 --- 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>) -> Result { +fn setup_op_decl( + mut terms: Vec>, + atom_tbl: TabledData, +) -> Result { 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 d30ba8fe..0277b1a6 100644 --- 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) ->