%%%%%%%%%%%%%%%%%%%%%%%%% marcus.p %%%%%%%%%%%%%%%%%%%%%%%%%%
%%%		A simple English parser
%%%		 for examples of Marcus, 1980
%%%        1993.9.21   H.Tsuda (tsuda@icot.or.jp)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% Category :
%%% {pos/POS, sc/SC, slash/SL, sem/SEM}
%%% POS: part of speech 
%%% SC: subcat (list of categories) 
%%% SL: slash  (list of categories)
%%% SEM: semantics (term)

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

parse(Str,Rest,Cat,Tree) :-
	lookup(Str,SubStr,WordSem,Tree1),!,
	parse1(WordSem,Tree1,SubStr,Rest,Cat,Tree).

parse1(Cat,Tree,Str,Str,Cat,Tree).
parse1(LCat,LTree,Str,Rest,Cat,Tree) :-
	parse(Str,SubStr,RCat,Tree1),
	psr(LCat,RCat,MCat,RNo),
	parse1(MCat,t(t(MCat,RNo,[]),LTree,Tree1),SubStr,Rest,Cat,Tree).


%% semantic_preference(Cat,P)
animate_pref({kind/high_animate},sem_very_good).
animate_pref({kind/animate},sem_good).
animate_pref({kind/inanimate},sem_bad).

lookup([Word|Rest],Rest,Cat,t(Cat,[Word],[])) :- 
	lexicon(Word,Cat).


noun(Sem,{pos/n,sc/[],slash/[],sem/Sem}).

lexicon(which,{pos/p,sc/[{pos/n,sem/X}],slash/[],sem/X}).
lexicon(who,{pos/p,sc/[],slash/[],sem/"?"}).
lexicon(him,{pos/p,sc/[],slash/[],sem/{name/he,sex/male,kind/high_animate}}).
lexicon(boy,Cat):- noun({name/boy,kind/high_animate},Cat).
lexicon(knight,Cat):- noun({name/knight,kind/high_animate},Cat).
lexicon(dragon,Cat):- noun({name/dragon,kind/animate},Cat).
lexicon(cannibals,Cat):- noun({name/cannibal,kind/high_animate},Cat).
lexicon(sword,Cat) :- noun({name/sword,kind/inanimate},Cat).
lexicon(the,{pos/p,sc/[{pos/n,sem/X}],slash/[],sem/X}).
lexicon(a,{pos/p,sc/[{pos/n,sem/X}],slash/[],sem/X}).
lexicon(give,{pos/v,sc/SC,slash/SL,
	sem/{act/give,agt/SBJ,do/DO,io/IO,sem_pref/SP,syn_pref/P}});
	slash_intro([{pos/p,sem/IO},{pos/p,sem/DO},{pos/p,sem/SBJ}],SC,SL,P),
	animate_pref(IO,SP).
lexicon(gave,{pos/v,sc/SC,slash/SL,
	sem/{act/gave,agt/SBJ,do/DO,io/IO,sem_pref/SP,syn_pref/P}});
	slash_intro([{pos/p,sem/IO},{pos/p,sem/DO},{pos/p,sem/SBJ}],SC,SL,P),
	animate_pref(IO,SP).
lexicon(hit,{pos/v,sc/SC,slash/SL,
	sem/{act/hit,agt/SBJ,obj/Obj}});
	slash_intro([{pos/p,sem/Obj},{pos/p,sem/SBJ}],SC,SL,_).
lexicon(run,{pos/v,sc/SC,slash/SL,sem/{act/run, agt/SBJ}});
	slash_intro([{pos/p,sem/SBJ}],SC,SL,_).
lexicon(did,{pos/aux,sc/[{pos/v,slash/SL,sc/[],sem/X}],slash/SL,sem/X}).

%% slash_introduction(SC,NewSC,NewSL,Pref)
slash_intro([E],[E],[],0).
slash_intro([E1,E2],[E1,E2],[],0).
slash_intro([E1,E2],[E2],[E1],0).
slash_intro([E1,E2,E3],[E1,E2,E3],[],next_as_io).
slash_intro([E1,E2,E3],[E2,E3],[E1],wh_as_io).
slash_intro([E1,E2,E3],[E1,E3],[E2],next_as_io).


psr(L,R,M,No) :- sc_p(L,R,M,No).
%%% p-np, aux-vp
sc_p({pos/P,sc/[R|Rest],slash/SL,sem/X},R,
	{pos/P,sc/Rest,slash/SL,sem/X},[1]); left_head(P).
left_head(p).
left_head(aux).
%%% vp-obj
sc_p({pos/v,sc/[R,E|Rest],slash/SL,sem/X},R,
	{pos/v,sc/[E|Rest],slash/SL,sem/X},[2]).
%%% sbj-vp
sc_p(L,{pos/v,sc/[L],slash/SL,sem/X},{pos/v,sc/[],slash/SL,sem/X},[3]).
%%% relative clause
sc_p(L,{pos/aux,sc/[],slash/[L],sem/X},{pos/aux,sc/[],slash/[],sem/X},[4])
	;L={pos/p}.

%%% Examples
%%% (*) :-p([which,boy,did,the,knight,give,the,dragon]).	
%%% :-p([the,knight,gave,the,dragon,a,boy]).
%%% :-p([which,dragon,did,the,knight,give,the,boy]).
%%% :-p([the,knight,gave,the,boy,a,dragon]).
%%% (?) :-p([which,boy,did,the,knight,give,the,sword]).
%%% :-p([the,knight,gave,a,boy,the,sword]).
%%% :-p([which,sword,did,the,knight,give,the,boy]).
%%% :-p([the,knight,gave,the,boy,a,sword]).
%%% (?) :-p([which,boy,did,the,knight,give,the,cannibals]).
%%% :-p([what,did,the,knight,give,the,dragon]).
%%% (*) :-p([which,boy,did,the,knight,give,the,dragon]).
%%% :-p([which,dragon,did,the,knight,give,the,boy]).
%%% (?) :-p([which,boy,did,the,knight,give,the,sword]).
%%% :-p([the,knight,gave, the, dragon, the, boy]).
%%% :-p([the, knight, gave, the, boy, the, dragon]).