implement DCGs using the logical expansion of the draft proposal
This commit is contained in:
Mark Thom
@@ -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).
|
||||
|
||||
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),
|
||||
unravel_commas(((A, B), C), Body) :-
|
||||
!,
|
||||
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).
|
||||
unravel_commas((B, C), Body0),
|
||||
unravel_commas((A, Body0), Body).
|
||||
unravel_commas((A, B), (A, Body0)) :-
|
||||
!, unravel_commas(B, Body0).
|
||||
unravel_commas(Body, Body).
|
||||
|
||||
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).
|
||||
phrase(GRBody, S0) :-
|
||||
phrase(GRBody, S0, []).
|
||||
|
||||
/* 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).
|
||||
|
||||
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
|
||||
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_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) :- !.
|
||||
comma_ify([Term | Args], (Term, Terms)) :-
|
||||
comma_ify(Args, Terms).
|
||||
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) :-
|
||||
!,
|
||||
( 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).
|
||||
|
||||
Reference in New Issue
Block a user