%           -*-Mode: prolog;-*-

/***********************************************************************
*            NOTICE            ATTENTION            ACHTUNG            *
*                                                                      *
* This is the beginning of a sketch of a grammar.  Absolutely no       *
* guarantees are offered concerning what it might do to your language, *
* your future as a computational linguist, or your general health.     *
***********************************************************************/
    
:- ensure_loaded(library(lists)).
:- ensure_loaded('~/Prolog/new_record').
:- multifile dcl/2, portray/1.

dcl(agr,      [ pn, case]).
dcl(v_struct, [ stem, subj, arg1, arg2]).
dcl(v_cat,    [ form, (agr <- agr, pn, case), bar, needs, slash_in, slash_out]).
dcl(verb,     [ (struct <- v_struct, stem, subj, arg1, arg2),
                (cat <- v_cat, form, agr, pn, case, bar, needs,
		        slash_in, slash_out)]).

dcl(d_struct,[stem]).
dcl(d_cat,   [form, (agr <- agr, pn), slash_in, slash_out]).
dcl(det,     [ (struct <- d_struct, stem),
	       (cat <- d_cat, form, agr, pn, slash_in, slash_out)]).

dcl(n_struct,[stem, mods, det_struct]).
dcl(n_cat,   [form, bar, (agr <- agr, pn, case), slash_in, slash_out]).
dcl(noun,    [ (struct <- n_struct, det_struct, mods, stem),
	       (cat <- n_cat, form, bar, agr, pn, case, slash_in, slash_out)]).

dcl(prop_struct,[stem, mods, det_struct]).
dcl(prop_cat,   [form, bar, (agr <- agr, pn, case), slash_in, slash_out]).
dcl(prop,       [ (struct <- prop_struct, det_struct, mods, stem),
	          (cat <- prop_cat, form, bar, agr, pn, case, slash_in, slash_out)]).

dcl(prep_struct, [form]).
dcl(prep_cat,    [stem, slash_in, slash_out]).
dcl(prep,    [(struct <- prep_struct, form),
	      (cat <- prep_cat, stem, slash_in, slash_out)]).

dcl(rpro_struct, [form]).
dcl(rpro_cat,    [stem, slash_in, slash_out]).
dcl(rpro,    [(struct <- rpro_struct, form),
	      (cat <- rpro_cat, stem, slash_in, slash_out)]).

:- compile_declarations.

portray(X) :-
  portray_record(X).

/***********************************************************************
*                              THE LEXICON                             *
***********************************************************************/

% -------------------- Verbs --------------------

v_fin(Form, Stem, Agr, Entry) :-
  ( Entry <- verb, form=Form, stem=Stem, pn=PN, subj=Subj, slash_in=X, slash_out=X),
  ( Subj <- noun, pn=PN, case=nom, slash_in=X, slash_out=X),
  pn(Agr, PN).

vi(Form, Stem, Agr, Entry) :-
  ( Entry <- verb, arg1=none, arg2=none, needs=[]),
  v_fin(Form, Stem, Agr, Entry).

vt(Form, Stem, Agr, Entry) :-
  ( Entry <- verb, arg1=Obj, arg2=none, needs=[Obj],
             slash_in=X, slash_out=X),
  ( Obj <- noun, pn=PN, case=acc),
  v_fin(Form, Stem, Agr, Entry).

vd(Form, Stem, Agr, X) :-
  vdnp(Form, Stem, Agr, X).
vd(Form, Stem, Agr, X) :-
  vdpp(Form, Stem, Agr, X).

vdnp(Form, Stem, Agr, Entry) :-
  ( Entry <- verb, arg1=Obj1, arg2=Obj2, needs=[Obj1, Obj2],
             slash_in=X, slash_out=X),
  ( Obj1 <- noun, pn=PN, case=acc),
  ( Obj2 <- noun, pn=PN, case=acc),
  v_fin(Form, Stem, Agr, Entry).

vdpp(Form, Stem, Agr, Entry) :-
  ( Entry <- verb, arg1=Obj2, arg2=PPObj, needs=[Obj, PP],
             slash_in=X, slash_out=X),
  v_fin(Form, Stem, Agr, Entry).

% Intransitive Verbs.

lex(sleeps, X) :- vi(sleeps, sleep, sg3, X).
lex(sleep, X) :-  vi(sleep,  sleep, not_sg3, X).
lex(slept, X) :-  vi(slept,  sleep, any, X).

% Transitive Verbs.

lex(chases, X) :- vt(chases, chase, sg3, X).
lex(chase, X) :-  vt(chase,  chase, not_sg3, X).
lex(chased, X) :- vt(chased, chase, any, X).

% Ditransitive Verbs.

lex(gives, X) :-    vd(gives, give, sg3, X).
lex(give, X)  :-    vd(give,  give, not_sg3, X).
lex(gave, X)  :-    vd(gave,  give, any, X).
lex(donates, X) :-  vdpp(donates, donate, sg3, X).
lex(donate, X)  :-  vdpp(donate,  donate, not_sg3, X).
lex(donated, X)  :- vdpp(donated, donate, any, X).

% -------------------- Nouns --------------------

noun(Form, Stem, Agr, Entry) :-
  ( Entry <- noun, form=Form, stem=Stem, pn=PN, slash_in=X, slash_out=X),
  pn(Agr, PN).

prop(Stem, Entry) :-
  ( Entry <- noun, stem=Stem, form=Stem, bar=1, pn=PN, slash_in=X, slash_out=X,
             det_struct=none, mods=none),
  pn(sg3, PN).

% -------------------- Determiners --------------------

det(Stem, Agr, Entry) :-
  ( Entry <- det, stem=Stem, form=Stem, pn=PN, slash_in=X, slash_out=X),
  pn(Agr, PN).

prep(Stem, Entry):-
  ( Entry <- prep, stem=Stem, slash_in=X, slash_out=X).

rpro(Stem, Entry):-
  ( Entry, E <- rpro, stem=Stem, form=Stem, slash_in=X, slash_out=X),
  (        E <- rpro, slash_in=X, slash_out=X).

% Determiners

lex(the, X) :-
  det(the, any, X).
lex(this, X) :-
  det(this, sg3, X).

% Common Nouns

lex(cat, X) :-  noun(cat,  cat, sg3, X).
lex(cats, X) :- noun(cats, cat, pl3, X).
lex(dog, X) :-  noun(dog,  dog, sg3, X).
lex(dogs, X) :- noun(dogs, dog, pl3, X).

% Proper Nouns

lex(john, X) :- prop(john, X).
lex(mary, X) :- prop(mary, X).
lex(fido, X) :- prop(fido, X).

% Prepositions.

lex(to, X) :- prep(to, X).
lex(by, X) :- prep(by, X).

% Relative pronouns.

lex(that, X) :- rpro(that, X).

% -------------------- Phrases --------------------

% Sentences.

rule(S, [NP, VP]) :-
  (S,  V <- verb, subj=Np_struct, bar=1, needs=[]),
  (VP, V <- verb, needs=[], bar=0),
  (NP    <- noun, bar=1, struct=Np_struct).

% Verb phrases.

rule(VP0, [VP1, NP]) :-
  (NP <- noun, bar=1, struct=NS),
  (VP1, V <- verb, needs=[NP]),
  (VP0, V <- verb, arg2=NS, needs=[]).

% Noun phrases.

rule(NP, [Det, N]) :-
  (NP, X <- noun, bar=1, agr=Agr, det_struct=D),
  (Det   <- det, struct=D, agr=Agr),
  (N, X  <- noun, bar=0, agr=Agr).
rule(NP, [NP0, RPRO, S]) :-
  (NP0 <- noun, bar=1),
  (RPRO <- rpro),
  (S <- verb, bar=1, slash_in=NP0, slash_out=[]),
  (NP <- noun, mods=S).

pn(sg3,     pn(0, 0, 1)).
pn(not_sg3, pn(_, X, X)).
pn(pl3,     pn(0, 0, 0)).
pn(3,       pn(0, 0, _)).
pn(any,     pn(_, _, _)).

parse_sentence(String) :-
  length(String, L),
  (S <- verb),
  parse(String, S),
  show_chart(L).

parse_np(String) :-
  length(String, L),
  (S <- noun),
  parse(String, S),
  show_chart(L).