From 8df346f3775c627a1a19265a5ed62a2eea8f9818 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 20 Jan 2022 23:32:08 -0700 Subject: [PATCH] expand phrase/{2,3} using dcg_body whenever possible --- src/lib/clpz.pl | 4 +- src/lib/dcgs.pl | 152 ++++++++++++++------------------------ tests/scryer/src_tests.rs | 4 +- 3 files changed, 59 insertions(+), 101 deletions(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index f330b36f..ceac0221 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -6169,7 +6169,7 @@ distinct_goals_([flow_to(F,To)|Es], V) --> get_attr(To, lowlink, L2), L1 =\= L2 } -> { get_attr(To, value, N) }, - [neq_num(V, N)] + [clpz:neq_num(V, N)] ; [] ), distinct_goals_(Es, V). @@ -6690,7 +6690,7 @@ gcc_edge_goal(arc_to(_,_,V,F), Val) --> get_attr(Val, lowlink, L2), L1 =\= L2, get_attr(Val, value, Value) } -> - [neq_num(V, Value)] + [clpz:neq_num(V, Value)] ; [] ). diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl index 10eab327..7d6dd905 100644 --- a/src/lib/dcgs.pl +++ b/src/lib/dcgs.pl @@ -20,84 +20,52 @@ load_context(GRBody, Module, GRBody0) :- ; true ). + :- meta_predicate phrase(2, ?). :- meta_predicate phrase(2, ?, ?). phrase(GRBody, S0) :- - load_context(GRBody, Module, GRBody0), - phrase(GRBody0, S0, [], Module). + phrase(GRBody, S0, []). phrase(GRBody, S0, S) :- load_context(GRBody, Module, GRBody0), - phrase(GRBody0, S0, S, Module). - -phrase(GRBody, S0, S, Module) :- - ( var(GRBody) -> - throw(error(instantiation_error, phrase/3)) - ; dcg_constr(GRBody) -> - phrase_(GRBody, S0, S, Module) - ; callable(GRBody) -> - call(Module:GRBody, S0, S) - ; throw(error(type_error(callable, Module:GRBody), phrase/3)) + ( var(GRBody0) -> + instantiation_error(phrase/3) + ; dcg_body(GRBody0, S0, S, GRBody1, Module) -> + call(GRBody1) + ; type_error(callable, GRBody0, phrase/3) ). -phrase_([], S, S, _). -phrase_(!, S, S, _). -phrase_((A, B), S0, S, M) :- - phrase(A, S0, S1, M), - phrase(B, S1, S, M). -phrase_((A -> B ; C), S0, S, M) :- - ( phrase(A, S0, S1, M) -> - phrase(B, S1, S, M) - ; phrase(C, S0, S, M) - ). -phrase_((A ; B), S0, S, M) :- - ( phrase(A, S0, S, M) - ; phrase(B, S0, S, M) - ). -phrase_((A | B), S0, S, M) :- - ( phrase(A, S0, S, M) - ; phrase(B, S0, S, M) - ). -phrase_({G}, S, S, M) :- - call(M:G). -phrase_(call(G), S0, S, M) :- - call(M:G, S0, S). -phrase_((A -> B), S0, S, M) :- - ( phrase(A, S0, S1, M) -> - phrase(B, S1, S, M) - ; fail + +module_call_qualified(M, Call, Call1) :- + ( nonvar(M) -> Call1 = M:Call + ; Call = Call1 ). -phrase_(phrase(NonTerminal), S0, S, M) :- - phrase(NonTerminal, S0, S, M). -phrase_([T|Ts], S0, S, _) :- - must_be(list, [T|Ts]), - append([T|Ts], S, S0). % The same version of the below two dcg_rule clauses, but with module scoping. dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :- dcg_non_terminal(NonTerminal, S0, S, Head), - dcg_body(GRBody, S0, S1, Goal1), + dcg_body(GRBody, S0, S1, Goal1, _), dcg_terminals(Terminals, S, S1, Goal2), Body = ( Goal1, Goal2 ). dcg_rule(( M:NonTerminal --> GRBody ), ( M:Head :- Body )) :- NonTerminal \= ( _, _ ), dcg_non_terminal(NonTerminal, S0, S, Head), - dcg_body(GRBody, S0, S, Body). + dcg_body(GRBody, S0, S, Body, _). % 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_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_body(GRBody, S0, S, Body, _). dcg_non_terminal(NonTerminal, S0, S, Goal) :- NonTerminal =.. NonTerminalUniv, @@ -107,18 +75,20 @@ dcg_non_terminal(NonTerminal, S0, S, Goal) :- dcg_terminals(Terminals, S0, S, S0 = List) :- append(Terminals, S, List). -dcg_body(Var, S0, S, Body) :- +dcg_body(Var, S0, S, Body, M) :- var(Var), - Body = phrase(Var, S0, S). -dcg_body(GRBody, S0, S, Body) :- + module_call_qualified(M, Var, Var1), + Body = phrase(Var1, S0, S). +dcg_body(GRBody, S0, S, Body, M) :- nonvar(GRBody), dcg_constr(GRBody), - dcg_cbody(GRBody, S0, S, Body). -dcg_body(NonTerminal, S0, S, Goal) :- + dcg_cbody(GRBody, S0, S, Body, M). +dcg_body(NonTerminal, S0, S, Goal1, M) :- nonvar(NonTerminal), \+ dcg_constr(NonTerminal), NonTerminal \= ( _ -> _ ), NonTerminal \= ( \+ _ ), + module_call_qualified(M, Goal, Goal1), dcg_non_terminal(NonTerminal, S0, S, Goal). % The following constructs in a grammar rule body @@ -137,37 +107,40 @@ 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_cbody([], S0, S, S0 = S, _M). +dcg_cbody([T|Ts], S0, S, Goal, _M) :- must_be(list, [T|Ts]), 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 )) :- +dcg_cbody(( GRFirst, GRSecond ), S0, S, ( First, Second ), M) :- + dcg_body(GRFirst, S0, S1, First, M), + dcg_body(GRSecond, S1, S, Second, M). +dcg_cbody(( GREither ; GROr ), S0, S, ( Either ; Or ), M) :- \+ subsumes_term(( _ -> _ ), GREither), - dcg_body(GREither, S0, S, Either), - dcg_body(GROr, S0, S, Or). -dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else )) :- + dcg_body(GREither, S0, S, Either, M), + dcg_body(GROr, S0, S, Or, M). +dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else ), M) :- 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). + dcg_cbody(GRCond, S0, S, Cond, M), + dcg_body(GRElse, S0, S, Else, M). +dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or ), M) :- + dcg_body(GREither, S0, S, Either, M), + dcg_body(GROr, S0, S, Or, M). +dcg_cbody({Goal}, S0, S, ( Goal1, S0 = S ), M) :- + module_call_qualified(M, Goal, Goal1). +dcg_cbody(call(Cont), S0, S, call(Cont1, S0, S), M) :- + module_call_qualified(M, Cont, Cont1). +dcg_cbody(phrase(Body), S0, S, phrase(Body1, S0, S), M) :- + module_call_qualified(M, Body, Body1). +dcg_cbody(!, S0, S, ( !, S0 = S ), _M). +dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody1,S0,_), S0 = S ), M) :- + module_call_qualified(M, GRBody, GRBody1). +dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then ), M) :- + dcg_body(GRIf, S0, S1, If, M), + dcg_body(GRThen, S1, S, Then, M). user:term_expansion(Term0, Term) :- nonvar(Term0), - dcg_rule(Term0, (Head :- Body)), - Term = (Head :- Body). + dcg_rule(Term0, Term). % Describes a sequence seq([]) --> []. @@ -180,24 +153,9 @@ seqq([Es|Ess]) --> seq(Es), seqq(Ess). % Describes an arbitrary number of elements ... --> [] | [_], ... . -user:goal_expansion(phrase(GRBody, S, S0), phrase(GRBody1, S, S0)) :- - strip_module(GRBody, M, GRBody0), - var(M), - prolog_load_context(module, M), - ( nonvar(GRBody0) -> - GRBody0 \== [], - dcg_constr(GRBody0), - predicate_property(GRBody0, meta_predicate(_)) - ), - GRBody1 = M:GRBody0. - -user:goal_expansion(phrase(GRBody, S), phrase(GRBody1, S, [])) :- - strip_module(GRBody, M, GRBody0), - var(M), - prolog_load_context(module, M), - ( nonvar(GRBody0) -> - GRBody0 \== [], - dcg_constr(GRBody0), - predicate_property(GRBody0, meta_predicate(_)) - ), - GRBody1 = M:GRBody0. +user:goal_expansion(phrase(GRBody, S, S0), GRBody1) :- + load_context(GRBody, M, GRBody0), + nonvar(GRBody0), + dcg_body(GRBody0, S, S0, GRBody1, M). + +user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])). diff --git a/tests/scryer/src_tests.rs b/tests/scryer/src_tests.rs index 24259f3a..5e7b74a8 100644 --- a/tests/scryer/src_tests.rs +++ b/tests/scryer/src_tests.rs @@ -51,7 +51,7 @@ fn rules() { fn setup_call_cleanup_load() { load_module_test( "src/tests/setup_call_cleanup.pl", - "1+21+31+2>_14219+_142201+_128131+2>41+2>_142201+2>31+2>31+2>4ba" + "1+21+31+2>_15388+_153891+_139341+2>41+2>_153891+2>31+2>31+2>4ba" ); } @@ -60,7 +60,7 @@ fn setup_call_cleanup_process() { run_top_level_test_with_args( &["src/tests/setup_call_cleanup.pl", "-f", "-g", "halt"], "", - "1+21+31+2>_15618+_156191+_142121+2>41+2>_156191+2>31+2>31+2>4ba" + "1+21+31+2>_16835+_168361+_153811+2>41+2>_168361+2>31+2>31+2>4ba" ); } -- 2.54.0