%%%%%%%%%%%%%%%%%%%%%%%%% hpsg.p %%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%	Simple	HPSG parser
%%			1994.5.20
%%      grammar by G.Smolka
%%      programmed by H.Tsuda
%%    {head/_, sc/_, ph/_}
%% ----------------------------------------------------
%%	head: head feature
%%	sc:   subcat feature
%%	ph:   phnological feature
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%%  Example.
%%  ?-p([mary,meets,john]).
%%  ?-p([the,girl,is,mary]).
%%  ?-p([mary,is,embarrassed]).
%%

%%  Left Corner Parser
p(Sentence):-
	parse0(Cat,H,Sentence,[]),nl,
	tree(H),nl,
	write("category= "),write(Cat),nl,
	write("constraint= "),pcon,nl.

parse0(MCat,MHist,Str,Rest):-
	lookup(Str,SubStr,Cat,Hist),!,
	parse1(Cat,Hist,MCat,MHist,SubStr,Rest).

parse1(Cat,H,Cat,H,Str,Str).

parse1(LCat,LHist,GCat,GHist,Str,Rest):-
	psr(LCat,RCat,MCat,RN),
	parse0(RCat,RHist,Str,SubStr),
	parse1(MCat,t(t(MCat,RN,[]),LHist,RHist),
		GCat,GHist,SubStr,Rest).


%%%  phrase structure rules
%%%     psr(LeftCat,RightCat,MotherCat)
psr(Head,D,P,1);           %  Right head
   sc_p(Head,D,P),
   head_p(Head,P),
   ph_p(Head,D,P).
psr(D,Head,P,2);           %  Left head
   sc_p(Head,D,P),
   head_p(Head,P),
   ph_p(D,Head,P).

%% head feature principle
%% head_p(HeadDaughter, Mother)
head_p({head/H},{head/H}).

%% phonology feature principle
%% ph_p(LeftDaughter, RightDaughter, Mother)
ph_p({ph/LP},{ph/RP},{ph/PP}) :- append(LP,RP,PP).

%% subcat feature principle
%% sc_p(Head,Daughter,Mother)
sc_p({sc/[RH|PSC]},{head/RH,sc/[]},{sc/PSC}).

%%%	dictionary
%%%  	lookup(Str,RestStr,Cat,History)
lookup([Word|X],X,{ph/[Word],head/Cat,sc/SC},t(Cat,[Word],[]))
	:-dict(Word,Cat,SC).

dict(mary, noun, []).
dict(john, noun, []).
dict(girl, noun, [determiner]).
dict(nice,adjective,[]).
dict(pretty,adjective,[]).
dict(the,determiner,[]).
dict(laughs,verb,[noun]).
dict(meets,verb,[noun,noun]).
dict(kisses,verb,[noun,noun]).
dict(embarrasses,verb,[noun,noun]).
dict(thinks,verb,[verb,noun]).
dict(is,verb,[adjective,noun]).
dict(met,adjective,[]).
dict(kissed,adjective,[]).
dict(embarrassed,adjective,[]).

%%%  constraints definition
append([],X,X).
append([A|X],Y,[A|Z]):-append(X,Y,Z).

member(X,[X|Y]).
member(X,[Y|Z]):-member(X,Z).

%%%%%%%%%%%%% sahen constraint %%%%%%%%%%%%%%%%%%%