/*******************************************************/
/*  GramKit:   Example Grammar 2                       */
/*             -----------------                       */
/*  Syntax:    DCG (Definite Clause Grammar)           */
/*  Semantics: QLF (Quasi-Logical Form)                */
/*                                                     */
/*  Graham Wilcock   (graham@ccl.umist.ac.uk)   97/08  */
/*******************************************************/

:- multifile '--->'/2.       % Sicstus 3
:- op(1200,xfx,--->).        % Comma is op(1000,xfy,',').

/*******************************************************/
/*   Interface for bottom-up chart parser/generator    */
/*******************************************************/

string(Category, String) :- arg(2, Category, String-[]).

semantics(Category, Semantics) :- arg(4, Category, Semantics-[]).

lookup_word(Word, Category) :-
	(Category ---> [Word]).
lookup_word(Word, Category) :-
	\+ (Category ---> [Word]),
	write(Word), write(' is not in the lexicon'),nl,!,fail.
lookup_term(Term, Word, Category) :-
	(Category ---> [Word]),
	arg(4, Category, [Term|L]-L).

empty_sem(Pform, p(X,[Pform|P]-P,[np(X)],[]-[])).

/*******************************************************/
/*           Interface for tree printer                */
/*******************************************************/

format_tree_node(Node, Functor) :-
	functor(Node, Functor, _).

portray(X) :- write(X).

/*******************************************************/
/*                    Grammar                          */
/*******************************************************/

% Category(Index, [Phon|P]-P, Subcat, [LF_Term|L]-L).

s(E, P0-PN, [], L0-LN)  ---> 
	np(A, P0-P1, [], L0-L1), 
	vp(E, P1-PN, [np(A)], L1-LN).

np(X, P0-PN, [], L0-LN) --->
	det(X, P0-P1, [], L0-L1), 
	nbar(X, P1-PN, [det(X)], L1-LN).

nbar(X, P0-PN, [det(X)], L0-LN) --->
	n(X, P0-PN, [det(X)], L0-LN).

vp(E, P0-PN, [Subj], L0-LN) --->
	v(E, P0-PN, [Subj], L0-LN).

vp(E, P0-PN, [Subj], L0-LN) ---> 
	v(E, P0-P1, [Subj,np(X)], L0-L1),
	np(X, P1-PN, [], L1-LN).

vp(E, P0-PN, [Subj], L0-LN) --->
	v(E, P0-P1, [Subj,np(X),np(Y)], L0-L1),
	np(X, P1-P2, [], L1-L2), 
	np(Y, P2-PN, [], L2-LN).

vp(E, P0-PN, [Subj], L0-LN) --->
	v(E, P0-P1, [Subj,np(X),pp(Pform,Y)], L0-L1),
	np(X, P1-[Pform|P2], [], L1-L2), 
	pp(Y, [Pform|P2]-PN, [], L2-LN).

pp(X, [Pform|P1]-PN, [], L0-LN) --->
	p(X, [Pform]-[], [np(X)], []-[]),
	np(X, P1-PN, [], L0-LN).

/*******************************************************/
/*                    Lexicon                          */
/*******************************************************/

np(X, ['Kim'|P]-P,   [], [name(X,'Kim')|L]-L)   ---> ['Kim'].
np(X, ['Sandy'|P]-P, [], [name(X,'Sandy')|L]-L) ---> ['Sandy'].

det(X, [a|P]-P, [], [indef(X)|L]-L) ---> [a].
det(X, [the|P]-P, [], [def(X)|L]-L) ---> [the].
det(X, [her|P]-P, [], [her(X)|L]-L) ---> [her].

n(X, [duck|P]-P,     [det(X)], [duck(X)|L]-L)     ---> [duck].
n(X, [man|P]-P,      [det(X)], [man(X)|L]-L)      ---> [man].
n(X, [woman|P]-P,    [det(X)], [woman(X)|L]-L)    ---> [woman].

% empty_sem (case-marking) prepositions
p(X, [at|P]-P, [np(X)], []-[]) ---> [at]. 
p(X, [on|P]-P, [np(X)], []-[]) ---> [on]. 
p(X, [to|P]-P, [np(X)], []-[]) ---> [to]. 

v(E, [died|P]-P, [np(A)], [die(E,A)|L]-L) ---> [died].
v(E, [ate|P]-P,  [np(A)], [eat(E,A)|L]-L) ---> [ate].

v(E, [ate|P]-P,  [np(A),np(B)], [eat(E,A,B)|L]-L) ---> [ate].
v(E, [saw|P]-P,  [np(A),np(B)], [see(E,A,B)|L]-L) ---> [saw].

v(E, [gave|P]-P,   [np(A),np(B),np(C)],    [give(E,A,B,C)|L]-L) ---> [gave].
v(E, [gave|P]-P,   [np(A),np(C),pp(to,B)], [give(E,A,B,C)|L]-L) ---> [gave].