Next: ref-gru-sum, Previous: ref-gru-exa, Up: ref-gru [Contents][Index]
Grammar rules are best explained in terms of an interpreter. The
semantics of phrase/3
is shown as if defined by the interpreter
shown below. The interpreter’s case analysis is as follows:
(Including cuts and module prefixes). The interpreter implements the semantics of the construct, descending into its argument. Note that other built-in predicates are not treated this way.
Treated as terminal symbols.
Treated as procedure calls.
A grammar rule with head functor N/A is looked up
using the imaginary predicate -->/2
,
unified against, and its body is interpreted.
If none exists, then this is treated as a procedure call to
a predicate N/A+2.
Raise error exception.
The following points are worth noting:
S0
and S
. -->/2
is not a predicate.
The interpreter is as follows, slightly simplified:
phrase(M:Body, S0, S) :- phrase(Body, M, S0, S). phrase(Var, M, S0, S) :- \+callable(Var), !, must_be(Var, callable, phrase(M:Var,S0,S), 1). phrase(M:Body, _, S0, S) :- !, phrase(Body, M, S0, S). phrase(!, _, S0, S) :- !, cut relevant choicepoints, S0 = S. % unification AFTER action phrase((A, B), M, S0, S) :- !, phrase(A, M, S0, S1), phrase(B, M, S1, S). phrase((A -> B), M, S0, S) :- !, ( phrase(A, M, S0, S1) -> phrase(B, M, S1, S) ). phrase((A -> B ; C), M, S0, S) :- !, ( phrase(A, M, S0, S1) -> phrase(B, M, S1, S) ; phrase(C, M, S0, S) ). phrase((A ; B), M, S0, S) :- !, ( phrase(A, M, S0, S) ; phrase(B, M, S0, S) ). phrase(\+(A), M, S0, S) :- !, ( phrase(A, M, S0, _) -> fail ; S0 = S ). phrase(_^A, M, S0, S) :- !, phrase(A, M, S0, S). phrase(do(Iter,Body), M, S0, S) :- !, ( Iter, fromto(S0,S1,S2,S) do phrase(Body, M, S1, S2) ). phrase(if(A,B,C), M, S0, S) :- !, if(phrase(A, M, S0, S1), phrase(B, M, S1, S), phrase(C, M, S0, S)). phrase(once(A), M, S0, S) :- !, ( phrase(A, M, S0, S1) -> S1 = S % unification AFTER call ). phrase([], _, S0, S) :- !, S0 = S. phrase([H|T], M, S0, S) :- !, S0 = [H|S1], phrase(T, M, S1, S). phrase({G}, M, S0, S) :- !, call(M:G), % Please note: transparent to cuts S0 = S. % unification AFTER call phrase(NT, M, S0, S) :- \+ \+(M:NT --> Rhs), !, % grammar rule exists? (M:NT --> Rhs), phrase(Rhs, M, S0, S). phrase(NT, M, S0, S) :- call(M:NT, S0, S). % otherwise, treat as procedure call
As mentioned above, grammar rules are merely a convenient abbreviation for ordinary Prolog clauses. Each grammar rule is translated into a Prolog clause as it is compiled. This translation is exemplified below.
The procedural interpretation of a grammar rule is that it takes an
input list of symbols or character codes, analyzes some initial
portion of that list, and produces the remaining portion (possibly
enlarged) as output for further analysis. The arguments required for
the input and output lists are not written explicitly in a grammar
rule, but are added when the rule is translated into an ordinary
Prolog clause. The translations shown differ from the output of
listing/[0,1]
in that internal translations such as variable
renaming are not represented. This is done in the interests of
clarity. For example, a rule such as (A) will be depicted as
translating into (B) rather than (C).
p(X) --> q(X). (A)
p(X, S0, S) :- q(X, S0, S). (B)
p(A, B, C) :- q(A, B, C). (C)
If there is more than one non-terminal on the right-hand side, as in (D), then the corresponding input and output arguments are identified, translating into (E):
p(X, Y) --> q(X), r(X, Y), s(Y). (D)
p(X, Y, S0, S) :- (E) q(X, S0, S1), r(X, Y, S1, S2), s(Y, S2, S).
Terminals are translated using the built-in predicate =/2
.
For instance, (F) is translated into (G):
p(X) --> [go, to], q(X), [stop]. (F)
p(X, S0, S) :- (G) S0 = [go,to|S1], q(X, S1, S2), S2 = [stop|S].
Extra conditions expressed as explicit procedure calls, enclosed in curly braces, naturally translate into themselves. For example (H) translates to (I):
p(X) --> [X], {integer(X), X > 0}, q(X). (H)
p(X, S0, S) :- (I) S0 = [X|S1], integer(X), X > 0, q(X, S1, S).
Terminals on the left-hand side of a rule, enclosed in square brackets, also translate into a unification. For example, (J) becomes (K):
is(N), [not] --> [aint]. (J)
is(N, S0, S) :- (K) S0 = [aint|S1], S = [not|S1].
Disjunction and other control constructs have a fairly obvious translation. For example, (L), a rule that equates phrases like “(sent) a letter to him” and “(sent) him a letter”, translates to (M):
args(X, Y) --> (L) ( indir(X), [to], indir(Y) ; indir(Y), dir(X) ).
args(X, Y, S0, S) :- (M) ( dir(X, S0, S1), S1 = [to|S2], indir(Y, S2, S) ; indir(Y, S0, S1), dir(X, S1, S) ).
In order to look at these translations, declare the grammar rules
dynamic and use listing/[0,1]
. However, bear in mind that
a grammar rule with head functor N/A is transformed to a Prolog
clause with head functor N/A+2. For example, the following declaration for
grammar rule (L) would enable you to list its translation, (M):
:- dynamic args/4.