/*
GRAMMAR.PL
Shelved on the 6th of December 1987
*/


/*  This file defines the predicate 'grexpand' for expanding grammar
    rules into Prolog clauses.

    It is derived from the Sussex version (hence the notice below):
    this in turn is the same (I think) as that published in Clocksin
    and Mellish, "Programming in Prolog".

                Jocelyn Ireson-Paine, St. Peters College, Oxford, 1987

    Derived from Sussex Poplog:
    Copyright University of Sussex 1982
*/


/*  The operator connecting the two sides of a grammar rule.
*/
?- op(255,xfx,-->).


/*  grexpand( Lhs0+, Rhs0+, Lhs-, Rhs- ):

    Grammar rule Lhs0-->Rhs0 translates into Prolog clause Lhs:-Rhs.

    As an example, if the grammar rule is
        l --> r1, r2, r3
    so that
        Lhs0 = l and Rhs0 = (r1,r2,r3)
    then the clause will be
        l( In, Out ) :- r1( In, V ), r2( V, V1), r3( V1, Out )
    where the In and Out are new variables introduced by 'grexpand'.

    Each of r1,r2,r3 takes 2 arguments : the first an instantiated list,
    and the second a variable.
    Each of r1,r2,r3 tries to parse its first argument, instantiating
    the second argument to what's left after the parse.
*/
grexpand(Lhs0,Rhs0,Lhs,Rhs) :-
      dcglhs(Lhs0,In,Out,Lhs), dcgrhs(Rhs0,In,Out,Q1),
      flatconj(Q1,Rhs).


/*  dcglhs( Lhs0+, In, Out, Lhs1- ):

    Lhs0 is the left hand side of a grammar rule.
    Lhs1 will become the head of a corresponding clause.
    In and Out are new variables introduced by grexpand.
*/
dcglhs((NT,Ts),In,Out,Lhs) :- !,
   nonvar(NT),
   islist(Ts),
   tag(NT,In,In1,Lhs),
   append(Ts,Out,In1).

dcglhs(NT,In,Out,Lhs) :-
   nonvar(NT),
   tag(NT,In,Out,Lhs).


/*  dcgrhs( Rhs0+, In, Out, Rhs1- ):

    Rhs0 is the right hand side of a grammar rule.
    Rhs1 will become the tail of a corresponding clause.
    In and Out are new variables introduced by grexpand.
*/
dcgrhs((X1,X2),In,Out,Lhs) :- !,
   dcgrhs(X1,In,In1,P1),
   dcgrhs(X2,In1,Out,P2),
   dcgand(P1,P2,Lhs).

dcgrhs((X1;X2),In,Out,(P1;P2)) :- !,
   dcgor(X1,In,Out,P1),
   dcgor(X2,In,Out,P2).

dcgrhs({Lhs},Out,Out,Lhs) :- !.

dcgrhs(!,Out,Out,!) :- !.

dcgrhs(Ts,In,Out,true) :-
   islist(Ts), !,
   append(Ts,Out,In).

dcgrhs(X,In,Out,Lhs) :- tag(X,In,Out,Lhs).


/*  dcgor( X+, In, Out, P- ):

    X is part of a disjunction occuring inside the RHS of a grammar rule.
    Expand into the corresponding part of a Prolog clause tail.
*/
dcgor(X,In,Out,Lhs) :-
   dcgrhs(X,Ina,Out,Pa),
 ( var(Ina), Ina \== Out, !, In=Ina, Lhs=Pa;
   Lhs=(In=Ina,Pa) ).


/*  tag( X+, In, Out, P- ):

    X is some atom or term occuring as a non-terminal in a grammar rule.
    P will become the corresponding goal in the Prolog clause resulting,
    after the input and output variables have been added to its argument
    list.
*/                    
tag(X,In,Out,Lhs) :-
   X=..[F|A],
   append(A,[In,Out],AX),
   Lhs=..[F|AX].


/* AUXILIARY PREDICATES */


/*  dcgand( G1+, G2+, G3- ):

    G1 and G2 are goals.
    G3 will become their conjunction, after removing surplus 'true's.
*/
dcgand(true,Lhs,Lhs) :- !.
dcgand(Lhs,true,Lhs) :- !.
dcgand(Lhs,Rhs,(Lhs,Rhs)).


/*  flatconj( C+, C1- ):

    C is a goal, or conjunction of goals.
    C1 will become a goal with the same effect, but with conjunctions
    as flat as possible.

    For example, (a,(b,c,(d,e))) becomes (a,b,c,d,e).
*/
flatconj(A,A) :- var(A), !.
flatconj((A,B),C) :- !, fc1(A,C,R), flatconj(B,R).
flatconj(A,A).


/*  fc1( C+, Result-, Ptr ):

    C is a conjunction of goals.
    Result will become the same conjunction, but with a final goal
    appended: this goal is the variable Ptr.
*/
fc1(A,(A,R),R) :- var(A), !.
fc1((A,B),C,R) :- !, fc1(A,C,R1), fc1(B,R1,R).
fc1(A,(A,R),R).


/*  islist( L+ ):

    L is the empty list, or something with a head and a tail.
*/
islist([]) :- !.
islist([_|_]).


/*  append( L1+, L2+, L3- ):

    L3 will become the result of appending list L1 to L2.
    Not resatisfiable.
*/
append( [], A, A ) :- !.
append( [H|T], A, [H|T1] ) :-
    append( T, A, T1 ), !.


/* PHRASE */


/*  phrase( Cat+, Words+ ):

    Words is a list of terminal symbols.
    Cat is some nonterminal of a grammer.

    Succeeds if Words parses by Cat, with no words left over.
*/                    
phrase(Cat,Words) :-
   Cat =.. List,
   append(List,[Words,[]],New),
   Goal =.. New,
   call(Goal).


/*

(1) SAMPLE GRAMMAR, AND ITS TRANSLATION

sentence --> np, verb, np.
np --> det, noun.
det --> [the].
det --> [a].
noun --> [dog].
noun --> [cat].
verb --> [ran].
verb --> [ate].
verb --> [saw].


np(_1, _2) :- det(_1, _3) , noun(_3, _2)
det([the | _4], _4) :- true
det([a | _5], _5) :- true
noun([dog | _6], _6) :- true
noun([cat | _7], _7) :- true
verb([ran | _8], _8) :- true
verb([ate | _9], _9) :- true
verb([saw | _10], _10) :- true



(2) USE OF PHRASE ON ABOVE GRAMMAR

?- phrase( sentence, [the,dog,saw,the,cat] ).
** (3) Call : sentence([the, dog, saw, the, cat], [])
** (4) Call : np([the, dog, saw, the, cat], _2)
** (5) Call : det([the, dog, saw, the, cat], _3)
** (5) Exit : det([the, dog, saw, the, cat], [dog, saw, the, cat])
** (6) Call : noun([dog, saw, the, cat], _2)
** (6) Exit : noun([dog, saw, the, cat], [saw, the, cat])
** (4) Exit : np([the, dog, saw, the, cat], [saw, the, cat])
** (7) Call : verb([saw, the, cat], _4)
** (7) Exit : verb([saw, the, cat], [the, cat])
** (8) Call : np([the, cat], [])
** (9) Call : det([the, cat], _5)
** (9) Exit : det([the, cat], [cat])
** (10) Call : noun([cat], [])
** (10) Exit : noun([cat], [])
** (8) Exit : np([the, cat], [])
** (3) Exit : sentence([the, dog, saw, the, cat], [])
yes



(3)  TWO SAMPLE RUNS OF GREXPAND

?- grexpand( noun, [dog], N, D ).
** (3) Call : grexpand(noun, [dog], _1, _2)
** (4) Call : dcglhs(noun, _4, _5, _1)
** (5) Call : tag(noun, _4, _5, _1)
** (6) Call : append([], [_4, _5], _6)
** (6) Exit : append([], [_4, _5], [_4, _5])
** (5) Exit : tag(noun, _4, _5, noun(_4, _5))
** (4) Exit : dcglhs(noun, _4, _5, noun(_4, _5))
** (7) Call : dcgrhs([dog], _4, _5, _7)
** (8) Call : islist([dog])
** (8) Exit : islist([dog])
** (9) Call : append([dog], _5, _4)
** (9) Exit : append([dog], _5, [dog | _5])
** (7) Exit : dcgrhs([dog], [dog | _5], _5, true)
** (11) Call : flatconj(true, _2)
** (11) Exit : flatconj(true, true)
** (3) Exit : grexpand(noun, [dog], noun([dog | _5], _5), true)
N = noun([dog | _5], _5)
D = true
More (y/n)? n


?- grexpand( sentence , (noun,verb), S, NV).
** (3) Call : grexpand(sentence, (noun , verb), _1, _2)
** (4) Call : dcglhs(sentence, _4, _5, _1)
** (5) Call : tag(sentence, _4, _5, _1)
** (6) Call : append([], [_4, _5], _6)
** (6) Exit : append([], [_4, _5], [_4, _5])
** (5) Exit : tag(sentence, _4, _5, sentence(_4, _5))
** (4) Exit : dcglhs(sentence, _4, _5, sentence(_4, _5))
** (7) Call : dcgrhs((noun , verb), _4, _5, _7)
** (8) Call : dcgrhs(noun, _4, _8, _9)
** (9) Call : islist(noun)
** (9) Fail : islist(noun)
** (10) Call : tag(noun, _4, _8, _9)
** (11) Call : append([], [_4, _8], _10)
** (11) Exit : append([], [_4, _8], [_4, _8])
** (10) Exit : tag(noun, _4, _8, noun(_4, _8))
** (8) Exit : dcgrhs(noun, _4, _8, noun(_4, _8))
** (12) Call : dcgrhs(verb, _8, _5, _11)
** (13) Call : islist(verb)
** (13) Fail : islist(verb)
** (14) Call : tag(verb, _8, _5, _11)
** (15) Call : append([], [_8, _5], _12)
** (15) Exit : append([], [_8, _5], [_8, _5])
** (14) Exit : tag(verb, _8, _5, verb(_8, _5))
** (12) Exit : dcgrhs(verb, _8, _5, verb(_8, _5))
** (16) Call : dcgand(noun(_4, _8), verb(_8, _5), _7)
** (16) Exit : dcgand(noun(_4, _8), verb(_8, _5), (noun(_4, _8) , verb(_8,
     _5)))
** (7) Exit : dcgrhs((noun , verb), _4, _5, (noun(_4, _8) , verb(_8, _5)))
** (17) Call : flatconj((noun(_4, _8) , verb(_8, _5)), _2)
** (18) Call : fc1(noun(_4, _8), _2, _13)
** (18) Exit : fc1(noun(_4, _8), (noun(_4, _8) , _13), _13)
** (19) Call : flatconj(verb(_8, _5), _13)
** (19) Exit : flatconj(verb(_8, _5), verb(_8, _5))
** (17) Exit : flatconj((noun(_4, _8) , verb(_8, _5)), (noun(_4, _8) ,
     verb(_8, _5)))
** (3) Exit : grexpand(sentence, (noun , verb), sentence(_4, _5), (noun(_4,
     _8) , verb(_8, _5)))
S = sentence(_4, _5)
NV = noun(_4, _8) , verb(_8, _5)
More (y/n)? n

*/
