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

s(F) --> np(F1), vp(F2), { not(member(passgap,F2)), agree([F1,F2],[agr]), inherit([agr],[F1,F2],F) }.

np(F) --> propernoun(F).
np(F) --> pronoun(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), subset([vform(ing),main],F2), inherit([agr,vform],[F1],F) }.

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

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

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

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

% VERB FORMS
% verb present tense
v([root(R),subcat(S),vform(pres),agr(s3)]) -->
	verb(F), [-s], { subset([root(R),subcat(S),vform(base)],F) }.

v([root(R),subcat(S),vform(pres),agr(A)]) -->
	verb(F), { agr(S), not(A=s3), subset([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)), subset([root(R),subcat(S),vform(base)],F) }.

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

v([root(R),subcat(S),vform(pastprt),agr(A)]) -->
	verb(F), [-ed], { agr(A), not(A=s3), subset([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), subset([root(R),subcat(S),vform(base)],F) }.

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

% TERMINAL SYMBOLS

% verb BASE FORMS

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

verb([cat(v),root(lift1),subcat(-np),vform(base),ed-pastprt]) --> [lift].
verb([cat(v),root(kill1),subcat(-np),vform(base),ed-pastprt]) --> [kill].
verb([cat(v),root(shout1),subcat(-none),vform(base),ed-pastprt]) --> [shout].

verb([cat(v),root(be1),subcat(-np),vform(pres)]) --> [am].
verb([cat(v),root(be1),subcat(-np),vform(pres)]) --> [are].
verb([cat(v),root(be1),subcat(-np),vform(pres)]) --> [is].
verb([cat(v),root(be1),subcat(-np),vform(past)]) --> [was].
verb([cat(v),root(be1),subcat(-np),vform(past)]) --> [were].
verb([cat(v),root(be1),subcat(-np),vform(pastprt)]) --> [been].
verb([cat(v),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(A),compform(base)]) --> [does], { agr(A), not(A=s3) }.
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(base),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)],[N|S],S) :- member(N,[bill,steve]).   % alternative II

% PRONOUNS

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

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

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

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

% AUXILIARY PREDICATES FOR FEATURES

% agree(Cs,Fs): test that constituents Cs agree on features Fs.
agree(Cs,[]).
agree(Cs,[F|Fs]) :- agree(Cs,Fs), 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).

% Printing sentences.

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

% Test the grammar

test :-
	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],[])), !,
	s(F,[],[]), !,
	s(F,[],[]), !,
	s(F,[],[]), !,