rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

expand phrase/{2,3} using dcg_body whenever possible

Browse Source
This commit is contained in:
Mark Thom
2022-01-20 23:32:08 -07:00
parent af76068297
commit 8df346f377
3 changed files with 58 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/lib/clpz.pl
View File

@@ -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)]
; []
).

150
src/lib/dcgs.pl
View File

@@ -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)
module_call_qualified(M, Call, Call1) :-
( nonvar(M) -> Call1 = M:Call
; Call = Call1
).
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
).
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, S0), GRBody1) :-
load_context(GRBody, M, GRBody0),
nonvar(GRBody0),
dcg_body(GRBody0, S, S0, GRBody1, M).
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), phrase(GRBody, S, [])).