% Exercise 4.6 (noun complements) and
% Exercise 4.7 (PP as noun postmodifiers)

% Derived from Program 4.2, PS p. 102 by Eric Auer
% use sample(X) and several ; ; ; to test this :-)

% English DCG producing logical forms.

:- op(500,xfy,&).
:- op(510,xfy,=>).

s(S) -->
	np(VP^S),
	vp(VP).

np(NP) -->
	det(N2^NP),
	n(N1),
	optrel(N1^N2).

% ****************************************

np((A^Sth)^Mpp) -->
	det(DET),
	n2(N2),
	thepp(PP),
	{ PP  = (B^Mdet)^Mpp,
	  DET = (A^Mn2)^(A^Sth)^Mdet,
	  N2  = A^B^Mn2
	}
%	{ format('~n DET=~p~n N2=~p~n PP=~p~n',
%	  [DET,N2,PP]) }
	.

np((a^Sth)^all(b,book(b) => exists(a, author_of(a,b) & Sth))) -->
	[a_a_o_e_b]. 	% for testing and at least figuring out
			% the wanted output of np(...). Ok 2am.

% so we have:
% LF of the np in the PP:
%    (B^Q)^all(B,book(B) => Q)
% LF of the main noun:
%    A^B^author_of(A,B)
% LF of the determiner:
%    (A^S1)^(A^Sth)^exists(A,S1 & Sth)
% target LF of the NP:
%    (A^Sth)^all(B,book(B) => exists(A, author_of(A,B) & Sth))
% thinking about unifications...
%    Q  = determiner matrix
%    S1 = main noun LF matrix
% output generated by instantiating parts of the PP

% phew! the a_a_o_e_b predefining trick finally got me the right
% idea,  PP = (B^Mdet)^Mpp,  DET = (A^Mn2)^(A^Sth)^Mdet,
% N2  = A^B^Mn2  and  output = (A^Sth)^Mpp
% give the right solution - 2:40am.

% ****************************************

np((B^Sth)^exists(B,book(B) & about(B,gottlob) & Sth)) -->
	[a_b_a_g]. % using the trick above again...

% LF of the determiner:    (B^S1)^(B^Sth)^exists(B,S1 & Sth)
% LF of book:              X^book(X) ... which is B^S1 ...
% LF of gottlob:           gottlob
% target: (B^Sth)^exists(B,book(B) & about(B,gottlob) & Sth)

np((B^Sth)^Mdet) -->
	det(DET),
	n(B^S1),
	[about],
	np(PP),
	{ DET = (B^S1x)^(B^Sth)^Mdet,
	  _N = B^_Mn,
	  PP = (PPit^PPand)^Mpp,
	  PPand = about(B,PPit),
%	  format('~n PPit=~p~n PPand=~p~n Mpp=~p~n PP=~p~n',
%	         [PPit,PPand,Mpp,PP]),
	  S1x = S1 & Mpp % main trick...
	}.


% ****************************************


np((E^S)^S) -->
	pn(E).

% ****************************************

thepp(PP) -->
	[of],
	np(PP).

% ****************************************

vp(X^S) -->
	tv(X^IV),
	np(IV^S).
vp(IV) -->
	iv(IV).

optrel((X^S1)^(X^(S1 & S2))) -->
	[that],
	vp(X^S2).
optrel(N^N) -->
	[].

det(LF) -->
	[D],
	{lex_det(D,LF)}.

lex_det(every, (X^S1)^(X^S2)^all(X,(S1=>S2))).
lex_det(a,     (X^S1)^(X^S2)^exists(X,S1&S2)).
lex_det(an,    (X^S1)^(X^S2)^exists(X,S1&S2)).

n(LF) --> % noun which cannot or does not take a PP
	[N],
	{lex_n(N,LF) }.

n2(LF) --> % noun which takes a PP
	[N2],
	{lex_n2(N2,LF) }.

% ****************************************

/*
	% that was the wrong scoping, sigh...
n(X^LFpp) --> 
	% noun which takes a PP (not elegant: other LF)
	[N2],
	{lex_n2(N2,X^LFn)},
	[of],
	np(LFn^LFpp),
	{ format('~n LFn=~p~n LFpp=~p~n',
	  [LFn,LFpp]) }.
*/

% ****************************************

lex_n(program, X^program(X)).
lex_n(student, X^student(X)).

% ****************************************

lex_n(author, X^author(X)).  % if used w/o PP
lex_n(book, X^book(X)).      % if used w/o PP

% for testing: pre-made "author of every book"
% looks as if we cannot do the needed scoping in the
% N rule at all :-( ... trying the NP rule.
% I guess this is why we do not need to handle optrel
% and PP at the same time, I should have guessed it...
lex_n(a_o_e_b, A^all( B, book(B) => author_of(A,B) ) ).

lex_n2(author, X^Y^author_of(X,Y)). % allow "author of ..."
lex_n2(book, X^Y^book(X,Y)).        % allow "book of ..."

% ****************************************

pn(E) -->
	[PN],
	{lex_pn(PN,E)}.

lex_pn(terry, terry).
lex_pn(bertrand, bertrand).
lex_pn(gottlob, gottlob).
lex_pn(shrdlu, shrdlu).

tv(LF) -->
	[TV],
	{lex_tv(TV,LF)}.

lex_tv(wrote, X^Y^wrote(X,Y)).

iv(LF) -->
	[IV],
	{lex_iv(IV,LF)}.

lex_iv(halts, X^halts(X)).


% ****************************************

sample(1) :- L = [an,author,of,every,book,wrote,a,program],
	phrase(s(X),L),
	format('~n L=~p~n X= ~p~n',[L,X]).
sample(2) :- L = [bertrand,wrote,a,book,about,gottlob],
	phrase(s(X),L),
	format('~n L=~p~n X= ~p~n',[L,X]).
sample(3) :- L = [bertrand,wrote,a,book,about,every,program],
	phrase(s(X),L),
	format('~n L=~p~n X= ~p~n',[L,X]).