%%%%%%%%%%%%%%%%%% GRAMMAR RULES %%%%%%%%%%%%%%%%

s(F) --> np(F1), vp(F2),
	{ features([case(nom)],F1),
	  features([{vform(pres),vform(past)},no(passgap)],F2),
	  agree([agr],[F1,F2]),
	  inherit([agr,vform],[F1,F2],F) }.

np(F) --> propernoun(F).
np(F) --> pronoun(F).

% VERB PHRASES

vp([main|F]) --> v(F1), { features([subcat(-none)],F1), inherit([agr,vform],[F1],F) }.
vp([main|F]) --> v(F1), np(F2), { member(subcat(-np),F1), features([case(acc)],F2), inherit([agr,vform],[F1],F) }.
vp([passgap,main|F]) --> v(F1), { member(subcat(-np),F1), inherit([agr,vform],[F1],F) }.

vp(F) --> v(F1), vp(F2), { member(subcat(-vp:inf),F1), features([inf],F2), inherit([agr,vform],[F1],F) }.
vp(F) --> v(F1), np(F2), vp(F3), { features([subcat(-np-vp:inf)],F1), features([case(acc)],F2), features([inf],F3), inherit([agr,vform],[F1],F) }.

vp([inf|F]) --> [to], vp(F1), { features([vform(base)],F1), inherit([agr,vform],[F1],F) }.

% AUXILIARY VERBS

vp(F) --> aux(F1), vp(F2),
   { member(compform(V),F1), member(vform(V),F2), inherit([agr,vform],[F1],F) }.

vp(F) --> aux(F1), vp(F2),
   { member(root(be-aux),F1), features([vform(ing),main],F2), inherit([agr,vform],[F1],F) }.

vp(F) --> aux(F1), vp(F2),
   { member(root(be-aux),F1), features([vform(ing),pass],F2), inherit([agr,vform],[F1],F) }.

vp([pass|F]) --> aux(F1), vp(F2),
   { member(root(be-aux),F1), features([vform(pastprt),main,passgap],F2), inherit([agr,vform],[F1],F) }.


%%%%%%%%%%%%% LEXICAL RULES %%%%%%%%%%%%%

% VERB FORMS DERIVED BY RULES FROM THEIR BASE FORMS
% From Grammar 4.5
% verb PRESENT TENSE
v([root(R),subcat(S),vform(pres),agr(s3)]) -->
	verb(F), [-s], { features([root(R),subcat(S),vform(base)],F) }.

v([root(R),subcat(S),vform(pres),agr(A)]) -->
	verb(F), { agr(A), not(A=s3), features([root(R),subcat(S),vform(base)],F) }.

% PAST TENSE
v([root(R),subcat(S),vform(past),agr(A)]) -->
	verb(F), [-ed], { agr(A), not(member(irreg-past,F)), features([root(R),subcat(S),vform(base)],F) }.

% PAST PARTICIPLE
v([root(R),subcat(S),vform(pastprt),agr(A)]) -->
	verb(F), [-n], { agr(A), features([root(R),subcat(S),vform(base),en-pastprt],F) }.

v([root(R),subcat(S),vform(pastprt),agr(A)]) -->
	verb(F), [-ed], { agr(A), features([root(R),subcat(S),vform(base),ed-pastprt],F) }.

% PRESENT PARTICIPLE
v([root(R),subcat(S),vform(ing),agr(A)]) -->
	verb(F), [-ing], { agr(A), features([root(R),subcat(S),vform(base)],F) }.

v(F) --> verb(F).

% TERMINAL SYMBOLS

% verb BASE FORMS

verb([root(see1),subcat(-np),vform(base),irreg-past,en-pastprt]) --> [see].
verb([root(see1),subcat(-np),vform(past)]) --> [saw].

verb([root(lift1),subcat(-np),vform(base),ed-pastprt]) --> [lift].
verb([root(kill1),subcat(-np),vform(base),ed-pastprt]) --> [kill].
verb([root(love1),subcat(-np),vform(base),ed-pastprt]) --> [love].
verb([root(shout1),subcat(-none),vform(base),ed-pastprt]) --> [shout].
verb([root(want1),subcat(SC),vform(base),ed-pastprt]) --> [want], { member(SC,[-np,-vp:inf,-np-vp:inf]) }.

verb([root(begin1),subcat(-vp:inf),vform(base),irreg-past]) --> [begin].

verb([root(be1),subcat(-np),vform(pres),agr(s1)]) --> [am].
verb([root(be1),subcat(-np),vform(pres),agr(A)]) --> [are], { member(A,[s2,p1,p2,p3]) }.
verb([root(be1),subcat(-np),vform(pres),agr(s3)]) --> [is].
verb([root(be1),subcat(-np),vform(past),agr(A)]) --> [was], { member(A,[s1,s3]) }.
verb([root(be1),subcat(-np),vform(past),agr(A)]) --> [were], { member(A,[s2,p1,p2,p3]) }.
verb([root(be1),subcat(-np),vform(pastprt)]) --> [been].
verb([root(want),subcat(SC),vform(base)]) --> [want], {member(SC,[-np,-vp:inf,-np-vp:inf])}.

aux([modal,root(can1),vform(pres),agr(A),compform(base)]) --> [can], {agr(A)}.
aux([modal,root(can1),vform(V),agr(A),compform(base)]) --> [could], { agr(A), member(V,[pres,past]) }.

aux([modal,root(do1),vform(pres),agr(A),compform(base)]) --> [do], { agr(A), not(A=s3) }.
aux([modal,root(do1),vform(pres),agr(s3),compform(base)]) --> [does].
aux([modal,root(do1),vform(past),agr(A),compform(base)]) --> [did], { agr(A) }.


aux([vform(base),root(have-aux),compform(pastprt)]) --> [have].
aux([vform(pres),root(have-aux),compform(pastprt),agr(A)]) --> [have], {agr(A), not(A=s3)}.
aux([vform(pres),root(have-aux),compform(pastprt),agr(s3)]) --> [has].

aux([vform(past),root(have-aux),compform(pastprt),agr(A)]) --> [had], {agr(A)}.
aux([vform(ing),root(have-aux),compform(pastprt)]) --> [having].

aux([vform(base),root(be-aux)]) --> [be].
aux([vform(pres),root(be-aux),agr(s1)]) --> [am].
aux([vform(pres),root(be-aux),agr(s3)]) --> [is].
aux([vform(pres),root(be-aux),agr(A)]) --> [are], {member(A,[s2,p1,p2,p3])}.
aux([vform(past),root(be-aux),agr(A)]) --> [was], {member(A,[s1,s3])}.
aux([vform(past),root(be-aux),agr(A)]) --> [were], {member(A,[s2,p1,p2,p3])}.
aux([vform(pastprt),root(be-aux),agr(A)]) --> [been], {agr(A)}.
aux([vform(ing),root(be-aux),agr(A)]) --> [being], {agr(A)}.


% PROPER NOUNS

propernoun([agr(s3),case(C)],[N|S],S) :- member(N,[bill,steve,janet,fido]), member(C,[acc,nom]).

% PRONOUNS

pronoun(N,[P|S],S) :- ispronoun(N,P).

% nominative
ispronoun([agr(s1),case(nom)],i).
ispronoun([agr(s2),case(nom)],you).
ispronoun([agr(s3),case(nom)],he).
ispronoun([agr(s3),case(nom)],she).
ispronoun([agr(s3),case(nom)],it).
ispronoun([agr(p1),case(nom)],we).
ispronoun([agr(p2),case(nom)],you).
ispronoun([agr(p3),case(nom)],they).

% accusative
ispronoun([agr(s1),case(acc)],me).
ispronoun([agr(s2),case(acc)],you).
ispronoun([agr(s3),case(acc)],him).
ispronoun([agr(s3),case(acc)],her).
ispronoun([agr(s3),case(acc)],it).
ispronoun([agr(p1),case(acc)],us).
ispronoun([agr(p2),case(acc)],you).
ispronoun([agr(p3),case(acc)],them).

%%%%%%%%%%%%% AUXILIARY DEFINITIONS %%%%%%%%%%%%%

agr(s1). agr(s2). agr(s3). agr(p1). agr(p2). agr(p3).

% AUXILIARY PREDICATES FOR FEATURES

% agree(Fs,Cs): test that constituents Cs agree on features Fs.
agree([],Cs).
agree([F|Fs],Cs) :- agree(Fs,Cs), functor(T,F,1), memberinall(T,Cs).

% inherit(Cs,Fs,C): combine features Fs from Cs to C.
inherit(Fs,Cs,C) :- inherit0(Fs,Cs,[],C).
inherit0([F|Fs],Cs,Ac,C) :- inherit1(Cs,F,Ac,Ac1), inherit0(Fs,Cs,Ac1,C).
inherit0([],Cs,Ac,Ac).
inherit1([C|Cs],F,Ac,Ac2) :-
	fmember(F,C,FVAL),
	inherit1(Cs,F,Ac,Ac1),
	union([FVAL],Ac1,Ac2).
inherit1([C|Cs],F,Ac,Ac1) :-
	not(fmember(F,C,_)),
	inherit1(Cs,F,Ac,Ac1).
inherit1([],F,Ac,Ac).

fmember(A,[T|_],T) :- functor(T,A,1), arg(1,T,V).
fmember(A,[A|_],A).
fmember(A,[B|L],AV) :- fmember(A,L,AV).	% or in the tail of the list.

% AUXILIARY PREDICATES

% negation as failure
not(G) :- G, !, fail.	% If goal G succeeds, commit to this clause, and fail.
not(G).			% Goal G did not succeed above, so not(G) succeeds.

% Is A a member of the list?
member(A,[A|_]).		% Yes, if it is the head of the list,
member(A,[_|L]) :- member(A,L).	% or in the tail of the list.

% Is E a member of every list?
memberinall(E,[]).
memberinall(E,[L|Ls]) :- member(E,L), memberinall(E,Ls).

% Union of two lists (a list that contains all members of the two lists)
union([],S,S).
union([E|Es],S,[E|S1]) :- not(member(E,S)), union(Es,S,S1).
union([E|Es],S,S1) :- member(E,S), union(Es,S,S1).

% Are all members of the first list members of the second?
subset([],S).
subset([E|Es],S) :- member(E,S), subset(Es,S).

%% Test for feature values
% f       there is feature f
% no(f)   there is no feature f
% {f1,...,fn}   there is at least one of the features f1,...,fn

features([],F) :- !.
features([{L}|E],F) :- !, tolist(L,LL), oneismember(LL,F), features(E,F).
features([no(C)|E],F) :- !, not(member(C,F)), features(E,F).
features([C|E],F) :- member(C,F), features(E,F).

tolist((A,B),[A|L]) :- !, tolist(B,L).
tolist(A,[A]).

oneismember([E|ES],L) :- member(E,L), !.
oneismember([E|ES],L) :- oneismember(ES,L).

%% Gaps
% One of the gaps [G1|Gs] equals G and the others are [].
gaps(G,[G1|Gs]) :- G = G1, emptygaps(Gs).
gaps(G,[G1|Gs]) :- G1 = [], gaps(G,Gs).
% All the remaining gaps are [].
emptygaps([]).
emptygaps([[]|Gs]) :- emptygaps(Gs).

% Printing sentences.

prints([]).
prints([-W|Ws]) :- write(W), !, prints(Ws).
prints([W|Ws]) :- write(' '), write(W), prints(Ws).

% Test the grammar

?- s(F1,[i,was,kill,-ed],[]).
?- s(F2,[i,have,shout,-ed],[]).
?- s(F3,[bill,kill,-s,steve],[]).
?- s(F4,[bill,has,kill,-ed,steve],[]).
?- not(s(F5,[i,have,kill,-ed],[])).	% PROBLEM
?- s(F,[steve,want,-s,bill,to,shout],[]).
?- s(F,[i,want,-ed,bill,to,kill,steve],[]).
?- s(F,[i,do,love,bill],[]).
?- s(F,[i,love,her],[]).