%Based on Graham Wilcock's implementation of the Sag and Wasow book
%Extended by Paul Bennett
%	  Additions include classification of verbs following Dixon 

/*******************************************************/
/*                 GramKit SW13-HPSG1                  */
/*      Implementing Sag & Wasow 1999 (Chapter 13)     */
/*       in ProFIT for GramKit parser/generator        */
/*                                                     */
/*  Graham Wilcock   (graham@ccl.umist.ac.uk)   98/12  */
/*******************************************************/

:- multifile '--->'/2.
:- op(1200, yfx, --->).
:- use_module(lists, library(lists), [append/3, 
		     		      is_list/1,
				      reverse/2,
				      permutation/2]).

/*******************************************************/
/*       Sort Hierarchy and Feature Declarations       */
/*******************************************************/

top > [feat_struc].
  feat_struc > [synsem_struc, agr_cat, gram_cat, val_cat, 
                pos, sem_struc, pred, ind].
    synsem_struc > [phrase, lex_item]
             intro [phon, syn:gram_cat, sem:sem_struc].
      lex_item > [word, lxm]
         intro [arg_st].
        lxm > [const_lxm, infl_lxm].
          const_lxm > [prep_lxm, adj_lxm, adv_lxm, conj_lxm, comp_lxm].
            prep_lxm > [pdp_lxm, mkp_lxm].
          infl_lxm > [noun_lxm, verb_lxm].
            noun_lxm > [pron_lxm, pn_lxm, cn_lxm].
            verb_lxm > [tv_lxm, iv_lxm, ppv_lxm, others].
               iv_lxm > [srv_lxm, motion_verb, rest_verb,
		         corporeal_verb, attention_verb, weather_verb].
	       tv_lxm > [rest_verb, follow_verb, give_verb, build_verb,
                         affect_verb, corporeal_verb, attention_verb, think_verb,
			 like_verb, annoy_verb, arrive_verb, speaking_verb].
               ppv_lxm > [rest_verb, corporeal_verb, speaking_verb, affect_verb].
	       others > [think_verb, extrap_lxm, sor_lxm, attention_verb].
	    adj_lxm > [raising_adj].
                         
              
    agr_cat fin_dom [m,f,n] * [sg,pl] * [1,2,3].
    gram_cat intro [head:pos, val:val_cat].
    val_cat intro [comps, spr].
    pos > [verb, adv, adj, conj, prep, nom, comp]
        intro [form, pred, mod].
        nom > [noun, det]
          intro [agr:agr_cat].
        noun intro [case, ana].
	det  intro [count].
      prep intro [p_obj].
      verb intro [aux, neg, inv].

    sem_struc intro [mode, index, restr].
      
      pred > [inst, arg, two_arg, name, sit]
         intro [reln, sit, det, event_time, ref_time, speech_time, aspect].
      inst intro [inst].
      arg  intro [arg, arbiter].
      two_arg intro [arg1, arg2].
      name intro [name, named].

      sit > [motion, rest, follow, affect, giving, corporeal, building,
	     attention, thinking, speaking, liking, annoying,
	     wanting, postponing, happy, aware, influence, commitment,
	     orientation].

	rest intro [causer, resting, locus, entity, object].
        follow intro [moving, locus].
	affect intro [agent, manipulated, target].
	building intro [agent, manipulated, product].
	giving intro [donor, gift, recipient].
	corporeal intro [causer, human, substance, thing].
	attention  intro [causer, perceiver, impression].
	thinking  intro [cogitator, thought].
        speaking intro [speaker, addressee, message].
	liking intro [experiencer, stimulus].
        happy intro [theme].
        aware intro [cogitator, stimulus].
	influence intro [influence, influenced, soa].
	commitment intro [committor, commissee, soa].
	orientation intro [experiencer, soa].


/*******************************************************/
/*               Phrase Structure Rules                */
/*******************************************************/

/******************************/
/*     HPSG Principles        */
/******************************/

/* Head Feature Principle */

'HFP1' := (syn!head!HF ---> [syn!head!HF|_]).
'HFP2' := (syn!head!HF ---> [_,syn!head!HF|_]).

/* Valence Principle */

'VALP1' := (syn!val!spr!Spr  ---> [syn!val!spr!Spr|_]).
'VALP2' := (syn!val!comps![] ---> [_,syn!val!comps![]|_]).

/* Semantics Principle */

'SemP1' := (sem!(mode!M & index!I) ---> [sem!(mode!M & index!I)|_]).
'SemP2' := (sem!(mode!M & index!I) ---> [_,sem!(mode!M & index!I)|_]).

'Restr1' := (sem!restr!R0-RN ---> [sem!restr!R0-RN]).
'Restr2' := (sem!restr!R0-RN ---> [sem!restr!R0-R1,sem!restr!R1-RN]).
'Restr3' := (sem!restr!R0-RN ---> [sem!restr!R0-R1,sem!restr!R1-R2,sem!restr!R2-RN]).

/* Phon Concatenation */

'Phon1' := (phon!P0-PN ---> [phon!P0-PN]).
'Phon2' := (phon!P0-PN ---> [phon!P0-P1,phon!P1-PN]).
'Phon3' := (phon!P0-PN ---> [phon!P0-P1,phon!P1-P2,phon!P2-PN]).

/******************************/
/* Head-Specifier Rule, p84   */
/******************************/

@'Phon2' & @'HFP2' & @'VALP2' & @'SemP2' & @'Restr2' & (
<phrase & syn!val!spr![]
--->
    [ Spr,
      <phrase & syn!val!spr![Spr] ]).

/******************************/
/* Head-Complement Rule, p85  */
/******************************/

@'Phon1' & @'HFP1' & @'VALP1' & @'SemP1' & @'Restr1' & (
<phrase & syn!val!comps![]
--->
    [ <word & syn!val!comps![]] ).

@'Phon2' & @'HFP1' & @'VALP1' & @'SemP1' & @'Restr2' & (
<phrase & syn!val!comps![]
--->
    [ <word & syn!val!comps![Comp],
      Comp & <phrase ]).

@'Phon3' & @'HFP1' & @'VALP1' & @'SemP1' & @'Restr3' & (
<phrase & syn!val!comps![]
--->
    [ <word & syn!val!comps![Comp1,Comp2],
      Comp1 & <phrase,
      Comp2 & <phrase ]).

/******************************/
/*  Head-Modifier Rule, p87   */
/******************************/


% Head precedes Modifier
@'Phon2' & @'HFP1' & @'SemP1' & @'Restr2' & (
<phrase & syn!Syn
--->
    [ Phrase & <phrase & syn!Syn,
      <phrase & syn!head!mod!Phrase ]).



% Modifier precedes Head
/*@'Phon2' & @'HFP2' & @'SemP2' & @'Restr2' & (
<phrase & syn!Syn
--->
    [ <phrase & syn!head!mod!Phrase,
      Phrase & <phrase & syn!Syn ]). */

%2/3/00 - a la Louisa/Doug
@'Phon2' & @'HFP2' & @'SemP2' & @'Restr2' & (
<word & syn!Syn
--->
    [ <word & syn!head!mod!Head,
      Head & <word & syn!Syn ]). 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%Head-Specifier-Complement Rule - PB, 6/3/00

@'Phon3' & @'HFP1' & @'VALP2' & @'Restr3' & (
<phrase & syn!val!spr![] & syn!val!comps![] & sem!(mode!ques & index!I) 
--->
    [ <word & syn!head!aux!+ & syn!val!spr![Spr] &
              syn!val!comps![Comp] & sem!index!I,
      Spr,
      Comp & <phrase ]).



%Imperative Rule - S&W p162 - PB, 6/3/00

@'Phon1' & @'HFP1' & @'Restr1' & (
<phrase & syn!(head!<verb & 
               val!(spr![] & comps![])) & 
          sem!(mode!dir & index!X)
--->
    [ <phrase & sem!index!X &
                syn!(head!form!inf & 
                     val!(spr![@'NP' & syn!head!agr!(2@agr_cat) & 
                          sem!(index!I & restr![reln!addressee & inst!I])]))]).
                     

%%%%%%%%%%%%%%%%%%%%%%
%Coordination Rule - S&W p121, PB, 14/12/00
%%%%%%%%%%%%%%%%%%%%%%

@'Phon3' & @'Restr3' & (     
<phrase & syn!Syn & sem!(index!I)      
--->
    [ <phrase & syn!Syn & sem!index!J,
      <word & syn!head!(<conj & mod!none) & sem!(index!I),
      <phrase & syn!Syn & sem!index!K]).

lex(Conj, <word & syn!(head!(<conj & mod!none)) &
                  sem!(index!I & mode!none & restr![reln!Conj & sit!I])) 
:-
	conj(Conj).

conj(and).


/*******************************************************/
/*                       Lexicon                       */
/*******************************************************/

/* Argument Realization Principle */
'ARP' := syn!val!(spr![Spr] & comps!Comps) &
	 arg_st![Spr|Comps].


'ARP0' := syn!val!(spr![] & comps![]) &
	 arg_st![].


%Case Constraint (S&W p184) 

'CC' := arg_st!([Spr, syn!head!case!acc|_] or 
                [Spr, syn!head!case!acc, syn!head!case!acc|_]). 


%Templates for Binding - PB 3/4/00
%Reflexive object
%'BIND' := arg_st![(sem!index!I & syn!head!agr!Agr), 
%	          (sem!index!I & syn!head!(ana!+ & agr!Agr))|_]. 

%Non-reflexive object
%'BIND' := arg_st![sem!index!I, (sem!index!J & syn!head!ana!-)|_]. 





/******************************/
/*  Abbreviation Templates    */
/******************************/

'D'  := <word   & syn!(head!(<det & mod!none) & val!(spr![] &comps![])).

'COMP'  := <word   & syn!head!<comp.

'N'   := <word   & syn!head!<noun.
'NOM' := <phrase & syn!(head!<noun & val!(spr![@'D'] & comps![])).   % p78
'NP'  := <phrase & syn!(head!<noun & val!(spr![]      & comps![])). % p79

nominal := syn!head!<noun.					    %PB - 20/8/01


%for NPs other than dummy 'it' and 'there'
refNP := @'NP' & sem!mode!ref.

'A'   := <word   & syn!head!<adj.
'AP'  := <phrase & syn!(head!<adj & val!comps![]).  %PB 28/2/00

'ADV'   := <word   & syn!head!<adv.
'ADVP'  := <phrase & syn!(head!<adv & val!(spr![] & comps![])).

'V'  := <word   & syn!head!<verb.
'VP' := <phrase & syn!(head!<verb & val!(spr![@'NP'] & comps![])).    % p78
'S'  := <phrase & syn!(head!<verb & val!(spr![]      & comps![])).  % p79

verbal := syn!(head!<verb & val!(spr![@'NP'])). %PB - 20/8/01

'SBAR'  := <phrase & syn!(head!<comp & val!spr![]).  %PB,16/2/00
'VPBAR'  := <phrase & syn!(head!<comp & val!spr![@'NP']).	%only needed for printing

'P'  := <word   & syn!head!<prep.
'PP' := <phrase & syn!head!<prep.

np(Index) := <phrase &
		   syn!(head!<noun &
		        val!(spr![] & comps![])) &
		   sem!index!Index.

accnp(Index) := <phrase &
		   syn!(head!case!acc &
		        val!(spr![] & comps![])) &
		   sem!index!Index.

pp(Form, Index) := <phrase &
		   syn!head!(<prep & form!Form) &
		   sem!index!Index.

s(Index) := <phrase &
	     syn!(head!<verb &
	          val!(spr![] & comps![])) &
	     sem!index!Index.	

%PB - 17/2/00
%finite clause, both with and without complementizer, cf. S&W p. 259
finclause(Index) := <phrase &
	     syn!(head!((<verb or <comp)& form!fin) &
	          val!(spr![] & comps![])) &
	     sem!index!Index.	



/******************************/
/*  Nominal Lexeme Templates  */
/******************************/

noun_lxm := <noun_lxm &
	syn!head!(<noun & mod!none & form!none & ana!-) &
	sem!mode!ref.                     % p177

pron_lxm := <pron_lxm &
	syn!(head!(<noun & mod!none & form!none) &
	     val!(spr![] & comps![])) &
	sem!mode!ref.

%dummy pronouns like it
dummy_lxm := <pron_lxm &
	syn!(head!(<noun & mod!none) &
	     val!(spr![] & comps![])) &
	sem!mode!none.


/******************************/
/*  Pronouns                  */
/******************************/

%Lexical Rule for Pronouns 
lex(Pron, <word & syn!Syn & sem!Sem)
:-
	lex(Pron, @pron_lxm & syn!Syn  & sem!Sem).

lex(Pron, @pron_lxm &
        syn!head!(case!Case & agr!Agr & ana!Ana) &
	sem!(index!I & restr![reln!Reln & inst!I]))
:-
	pron(Pron, Case, Agr, Reln, Ana).

%for dummy pronouns like 'it'
lex(Pron, <word & syn!Syn & sem!Sem)
:-
	lex(Pron, @dummy_lxm & syn!Syn  & sem!Sem).

lex(Pron, @dummy_lxm &
        syn!head!(form!Pron & agr!Agr) &
	sem!(index!none & restr![]))
:-
	dummy(Pron, Agr).



%Abbreviated entries for pronouns 
%orthography, case, agreement, restriction, anaphoric or not.
pron(he,  	nom, 3&sg&m,    male,      -).
pron(she,  	nom, 3&sg&f,    female,    -).
pron('I',	nom, 1&sg,      ego,       -).
pron(me,	acc, 1&sg,      ego,       -).
pron(him, 	acc, 3&sg&m,    male,      -).
pron(her, 	acc, 3&sg&f,    female,    -).
pron(himself,	acc, 3&sg&m,    male,      +).
pron(you,	_,   2@agr_cat, tu,        -).
pron(yourself,	acc, 2&sg,      tu,        +).
pron(they,	nom, 3&pl,      others,    -).
pron(them,	acc, 3&pl,      others,    -).
pron(it,	_,   3&sg,      neuter,    -).
pron(nobody,	_,   3&sg,      none,      -).
pron((someone or somebody),	_,   3&sg,      exists,    -).
pron((everyone or everybody),	_,   3&sg,      all,       -).

dummy(it, 3&sg).
dummy(there, 3@agr_cat).


/******************************/
/*  Determiners               */
/******************************/

lex(Det, @'D' &
	syn!head!(agr!Agr & count!+) &
	sem!(index!I & restr![det!SemDet & inst!I]))
:-
	det(Det, SemDet, Agr, c).

lex(Det, @'D' &
	syn!head!(agr!Agr & count!-) &
	sem!(index!I & restr![det!SemDet & inst!I]))
:-
	det(Det, SemDet, Agr, m).

lex(Det, @'D' &
	syn!head!agr!Agr &
	sem!(index!I & restr![det!SemDet & inst!I]))
:-
	det(Det, SemDet, Agr, cm).

det((a or an),     exists, 3&sg, c).
det(few,   few,    3&pl, c).
det(many,  much,   3&pl, c).
det(much,  much,   3&sg, m).
det(the,   def,    3@agr_cat, cm).
det(this,  this,   3&sg, cm).
det(these, this,   3&pl, c).
det(that,  that,   3&sg, cm).
det(those, that,   3&pl, c).
det(some,  exists, 3&pl, c).
det(some,  exists, 3&sg, m).
det(every, forall, 3&sg, c).
det(no,    notexists, 3@agr_cat, cm).

/******************************/
/*  Common Nouns              */    % p132, p140
/******************************/

% Common Noun Lexeme Template
cn_lxm(Reln, CT) := <cn_lxm & @noun_lxm &
	syn!head!agr!Agr &
	arg_st![Spr & @'D' & syn!head!(agr!Agr & count!CT) & sem!index!I] &
	sem!(index!I & restr![reln!Reln & inst!I]).


% Singular Noun Lexical Rule        % p145
lex(Noun, <word & @'ARP' &
	syn!(Syn & head!agr!(3&sg)) &
	arg_st!Arg_St &
        sem!Sem)
:-
    lex(Noun, @cn_lxm(_,_) &
	syn!Syn &
	arg_st!Arg_St &
	sem!Sem).

% Plural Noun Lexical Rule        % p146
lex(NounPl, <word & @'ARP' &
	syn!(Syn & head!agr!(3&pl)) &
	arg_st!Arg_St &
        sem!Sem)
:-
    lex(NounSg, @cn_lxm(_,+) &
	syn!Syn &
	arg_st!Arg_St &
	sem!Sem),
    morph_plural(NounSg, NounPl).

%Lexical Rules for Det-less nouns - 11/12/00
lex(NounPl, <word & 
	syn!(Syn & val!spr![] & head!agr!(3&pl)) &
	arg_st![] &
        sem!Sem)
:-
    lex(NounSg, @cn_lxm(_,+) &
	syn!Syn &
	sem!Sem),
    morph_plural(NounSg, NounPl).
    
lex(Noun, <word & 
	syn!(Syn & val!spr![] & head!agr!(3&sg)) &
	arg_st![] &
        sem!Sem)
:-
    lex(Noun, @cn_lxm(_,-) &
	syn!Syn &
	sem!Sem).

% Morphological Function for Plural
morph_plural(NounSg, NounPl) :-
	atomic(NounSg),
	name(NounSg, SpellSg),
	reverse(SpellSg, RevSg),
	reverse_plural(RevSg, RevPl),
	reverse(RevPl, SpellPl),
	name(NounPl, SpellPl).

%for 'children'
reverse_plural([0'd,0'l,0'i|Rev], [0'n,0'e,0'r,0'd,0'l,0'i|Rev]) :- !.
reverse_plural([0'n,0'a,0'm|Rev], [0'n,0'e,0'm|Rev]) :- !.
reverse_plural([0'y,Vowel|Rev], [0's,0'y,Vowel|Rev]) :- vowel(Vowel), !.
reverse_plural([0'y|Rev], [0's,0'e,0'i|Rev]) :- !.
reverse_plural([0's|Rev], [0's,0'e,0's|Rev]) :- !.
reverse_plural([0'x|Rev], [0's,0'e,0'x|Rev]) :- !.
reverse_plural(Rev, [0's|Rev]).

% Common Noun Lexeme List
lex(baby,       @cn_lxm(baby,+)).
lex(beer,       @cn_lxm(beer,-)).
lex(book,       @cn_lxm(book,+)).
lex(boss,       @cn_lxm(boss,+)).
lex(box,        @cn_lxm(box,+)).
lex(boy,        @cn_lxm(boy,+)).
lex(brick,      @cn_lxm(brick,+)).
lex(cake,       @cn_lxm(cake,_)).
lex(chair,      @cn_lxm(chair,+)).
lex(change,     @cn_lxm(change,+)).
lex(child,      @cn_lxm(child,+)).
lex(country,    @cn_lxm(country,+)).
lex(cupboard,   @cn_lxm(cupboard,+)).
lex(door,       @cn_lxm(door,+)).
lex(duck,       @cn_lxm(duck,+)).
lex(fish,       @cn_lxm(fish,_)).
lex(food,       @cn_lxm(food,-)).
lex(fridge,     @cn_lxm(fridge,+)).
lex(furniture,  @cn_lxm(furniture,-)).
lex(girl,       @cn_lxm(girl,+)).
lex(information,  @cn_lxm(information,-)).
lex(key,        @cn_lxm(key,+)).
lex(kitchen,    @cn_lxm(kitchen,+)).
lex(lamp,       @cn_lxm(lamp,+)).
lex(man,        @cn_lxm(man,+)).
lex(paper,      @cn_lxm(paper,-)).
lex(present,    @cn_lxm(present,+)).
lex(problem,    @cn_lxm(problem,+)).
lex(regulation, @cn_lxm(regulation,+)).
lex(rule,       @cn_lxm(rule,+)).
lex(stick,      @cn_lxm(stick,+)).
lex(student,    @cn_lxm(student,+)).
lex(table,      @cn_lxm(table,+)).
lex(wall,       @cn_lxm(wall,+)).
lex(woman,      @cn_lxm(woman,+)).


/******************************/
/*  Proper Nouns              */
/******************************/

% Proper Noun Lexeme Template    % p139
pn_lxm(Name) := <pn_lxm & @noun_lxm &
	syn!(head!agr!(3&sg) &
	     val!(spr![] & comps![])) &
	arg_st![] &
	sem!(index!I & restr![reln!name & name!Name & named!I]).

% Proper Noun Lexical Rule
lex(Name, <word & syn!Syn & arg_st!Arg_St & sem!Sem)
:-
	lex(Name, @pn_lxm(_) & syn!Syn & arg_st!Arg_St & sem!Sem).

% Proper Noun Lexeme List
lex('Dana', @pn_lxm('Dana')).
lex('John', @pn_lxm('John')).
lex('Kim',  @pn_lxm('Kim')).
lex('Pat',  @pn_lxm('Pat')).
lex('Sandy',@pn_lxm('Sandy')).
lex('Bob',  @pn_lxm('Bob')).

/******************************/
/*  Complementizers           */
/******************************/


%Complementizer lexeme template - PB 16/2/00
comp_lxm := <comp_lxm &
         syn!head!(<comp & mod!none) & sem!restr![].

lex(Comp, <word & syn!Syn & arg_st!Arg & sem!Sem)
:-
	comp(Comp, @comp_lxm & syn!Syn & arg_st!Arg & sem!Sem).

comp(that, @comp_lxm &
        syn!(head!form!fin & val!spr![] & 
             val!comps![@s(_) & syn!head!form!fin & sem!index!I]) &
        sem!index!I).

comp(to, @comp_lxm &
        syn!(head!(form!to &  mod!none) & val!spr![Subj] &
             val!comps![syn!head!(<verb & form!inf) & syn!val!spr![Subj] & sem!index!I]) &
        sem!index!I).
         


/******************************/
/*  Adjectives                */
/******************************/


% Adjective Lexeme Template     
adj_lxm := <adj_lxm & 
	syn!head!<adj &
	sem!(mode!prop).

tr_adj_lxm := <adj_lxm &
	syn!head!<adj &
	sem!(mode!prop & index!S & restr![sit!S]).

raising_adj := <raising_adj & @adj_lxm & @ssr. 

ssr := arg_st!([Subj, syn!val!spr![Subj]] or [Subj, PP, syn!val!spr![Subj]]).

%Adnominal Adjective Lexical Rule
lex(Adj, <word & syn!(Syn & val!(spr![] & comps![]) & 
			    head!(mod!(@nominal & sem!index!I) & pred!-)) & 
		 sem!(index!I & mode!prop & restr![inst!I & reln!Adj]))
:-
	lex(Adj, @adj_lxm & syn!Syn).

% Predicative Adjective Lexical Rule
%ARP now added here rather than in adj_lxm template above
lex(Adj, <word & @'ARP' & syn!(Syn & head!(pred!+ & mod!none)) &
                 arg_st!Arg_St & sem!Sem)
:-
	lex(Adj, @adj_lxm & syn!Syn & arg_st!Arg_St & 
                      sem!(Sem & index!S & restr![sit!S])).


% Adjective entries
%Lexical Rule for Intransitive Adjectives
lex(ADJ, @adj_lxm &
	arg_st![@np(J)] &
	sem!restr![reln!ADJ & theme!J])
:-
	adj(ADJ).



%Intransitive Adjective Lexemes.
adj(happy).
adj(short).
adj(tall).
adj(new).
adj(young).
adj(old).
adj(quiet).
adj(nice).
adj(pretty).

%predicative only
lex(asleep, @adj_lxm &
	syn!head!pred!+ &
	arg_st![@np(J)] &
	sem!restr![reln!asleep & theme!J]).

%attributive only
lex(same, @adj_lxm &
	syn!head!mod!@nominal &
	arg_st![@np(J)] &
	sem!restr![reln!same & theme!J]).

%Transitive example
% 'aware' takes 'of'-phrase or subord clause
lex(aware, @adj_lxm & 
	arg_st![@np(I), (@pp(of,J) or @finclause(J))] & 
	sem!restr![reln!aware & cogitator!I & stimulus!J]).

%SSR adjective
lex(Adj, @raising_adj & 
	arg_st![@'NP', syn!head!form!to & sem!index!I] & 
	sem!restr![reln!Adj & arg!I])
:-
   likely_adj(Adj, ssr).

%extraposed adjectives
lex(Adj, @adj_lxm & syn!(head!pred!+) &
          arg_st![@'NP' & syn!head!form!it, 
                  @finclause(I)] &
          sem!(index!Sit & 
               restr![reln!Adj & arg!I]))
:-
   likely_adj(Adj, extrap).

likely_adj(likely, (ssr or extrap)).	%Dixon pp 78 & 81
likely_adj(unlikely, (ssr or extrap)).
likely_adj(certain, (ssr or extrap)).
likely_adj(probable, extrap).
likely_adj(possible, extrap).
likely_adj(bound, ssr).



/******************************/
/*  Adverbs                   */
/******************************/

% Not                                    % p250
lex(not, <word & @'ARP0' &
	syn!head!(<adv & mod!none) &
	arg_st![] &
	sem!(index!S & restr![reln!not & sit!S & arg!E])).
	

% Adverb Lexeme Template
adv_lxm := <adv_lxm &
	syn!head!(<adv & mod!(@verbal & sem!index!E)) &
	arg_st![] &
	sem!(mode!prop & index!S & restr![sit!S & arg!E]).

% Adverb Lexical Rule
lex(Adv, <word & @'ARP0' &
	syn!Syn & arg_st!Arg_St & sem!Sem) 
:-
	lex(Adv, @adv_lxm & syn!Syn & arg_st!Arg_St & sem!Sem).

lex(today, @adv_lxm &
	sem!(restr![reln!today])).

lex(quickly, @adv_lxm &
	sem!(restr![reln!quick])).

/******************************/
/*  Prepositions              */
/******************************/

prep_lxm := <prep_lxm & 
	syn!head!(<prep & mod!none).      % p142

pdp_lxm := <pdp_lxm & @prep_lxm &
	syn!(head!p_obj!none &
	     val!spr![Spr]) &
	arg_st![Spr & @'NP', @'NP'].      % p142

mkp_lxm := <mkp_lxm & @prep_lxm &
	syn!(head!p_obj!Obj &
	     val!spr![]) &
	arg_st![Obj & @accnp(_)].        % p123, p142

% Argument-marking prepositions

lex(Prep, <word & 
	syn!(head!(<prep & pred!- & mod!none & p_obj!Obj & form!Prep) &
             val!(spr![] & comps![Obj])) &
	arg_st![Obj  & @accnp(I) & @refNP] &
	sem!(index!I & restr![]))
:-
	preposition(Prep, prd:n).

% Predicational prepositions

lex(Prep, <word & @'ARP' & @'CC' &
	syn!(head!(<prep & pred!+ & mod!none & p_obj!none & form!Type) &
             val!(spr![Spr] & comps![Obj])) &
	arg_st![Spr & @np(I) & @refNP, Obj & @np(J) & @refNP] &
	sem!(index!S & restr![reln!Prep & sit!S & resting!I & object!J]))
:-
	preposition(Prep, prd:y, Type).


preposition(at, prd:n).   % look at
preposition(by, prd:n).   % passive by
preposition(of, prd:n).   % aware of
preposition(on, prd:n).   % depend on
preposition(to, prd:n).   % give to
preposition(with, prd:n).
preposition(about, prd:n).   
preposition(against, prd:n).   
preposition(around, prd:n).   
preposition(in, prd:n).   
preposition(into, prd:n).   

preposition(on, prd:y, loc).   % put X on Y
preposition(in, prd:y, loc).   % put X in Y
preposition(under, prd:y, loc).   

/******************************/
/*  Auxiliary Verbs           */
/******************************/

% Negation Lexical Rule                  

lex(Lex, <word & 
	syn!(head!(form!fin & pred!- & aux!+ & neg!+ & mod!none) & 
	     val!(spr![Subj] & comps![Not|Args])) &
	arg_st![Subj, Not & @'ADVP' &  syn!head!mod!none &
		     sem!(index!Modality & restr!_)|Args] &
	sem!(index!Modality & restr!Restr))
:-
	lex(Lex, <word & syn!head!(form!fin & aux!+ & neg!-) &
		arg_st![Subj|Args] &
		sem!(index!Modality & restr!Restr)).



% Auxiliary Verb Lexeme Template           % p242
auxv_lxm := @srv_lxm & syn!head!aux!(+).  



% Auxiliary Verb Lexeme List

lex(be, @auxv_lxm &                        % p242
	syn!head!form!inf &
	arg_st![_Subj, syn!head!pred!+ & sem!index!I] &
	sem!(index!I & restr![])).

lex(have, @auxv_lxm &                      % p243
	syn!head!(form!inf & pred!-) &
	arg_st![_Subj, syn!head!form!psp & sem!index!I] &
	sem!(index!Sit & restr![reln!t_precede & event_time!I & ref_time!Sit])).	

lex(do, @auxv_lxm &                        % p248
	syn!head!form!fin &
	arg_st![_Subj, syn!head!(aux!- & form!inf) & sem!index!I] &
	sem!(index!I & restr![])).

mod(will, @auxv_lxm &                      % p251
	syn!head!form!fin &
	arg_st![_Subj,  sem!index!I] &
	sem!(index!I & restr![@t_follow(I)])). 


%for there is ...
lex(be, @verb_lxm &                        
	syn!head!(form!inf & aux!+) &
	arg_st![syn!head!(form!there & agr!Agr), 
                @refNP & syn!head!agr!Agr & sem!index!I] &
	sem!(index!S & restr![reln!exist & sit!S & entity!I])).


% Modal Verb Lexical Rule
%Amended by PB, 9/3/00, 
%to require subject to be case!nom and complement to be verbal
lex(ModalVerb, <word & @'ARP' &
        syn!(Syn & head!form!fin) &
	arg_st!Arg_St & arg_st![syn!head!case!nom, syn!head!(<verb & form!inf)] &
        sem!Sem)
:-
	mod(ModalVerb, @auxv_lxm &
        	syn!Syn &
		arg_st!Arg_St &
	        sem!Sem).

% Modal Verb Lexeme List


mod(can, @auxv_lxm &                     
	syn!head!form!fin &
	arg_st![_Subj, sem!index!I] &
	sem!(index!Sit & restr![reln!can & sit!Sit & arg!I, @t_overlap(Sit)])).

mod(must, @auxv_lxm &
	syn!head!form!fin &
	arg_st![_Subj, sem!index!I] &
	sem!(index!Sit & restr![reln!necessary & sit!Sit & arg!I, @t_overlap(Sit)])).

mod(may, @auxv_lxm &
	syn!head!form!fin &
	arg_st![_Subj, sem!index!I] &
	sem!(index!Sit & restr![reln!possible & sit!Sit & arg!I, @t_overlap(Sit)])).



/******************************/
/*  Main Verbs                */
/******************************/

% Tense Templates

t_overlap(Sit) := reln!t_overlap & ref_time!Sit & speech_time!now.

t_precede(Sit) := reln!t_precede & ref_time!Sit & speech_time!now.

t_follow(Sit) := reln!t_follow & ref_time!Sit & speech_time!now.


% Verbal Lexeme Templates            % p132, p141, p200 
verb_lxm := <verb_lxm &
	syn!head!(<verb & pred!- & mod!none) &
	arg_st![@'NP'|_] &
	sem!mode!prop.

main_verb_lxm := @verb_lxm &
	syn!head!(aux!- & neg!-) &
	sem!(index!Sit & restr![sit!Sit|_]).

srv_lxm := <srv_lxm & @verb_lxm & @ssr.    
	
sor_lxm := <think_verb & @main_verb_lxm & 
	arg_st![_Subj, Obj, syn!val!spr![Obj]].

extrap_lxm := <extrap_lxm & @main_verb_lxm &         
	arg_st![_Subj, _SCOMP|_].

tv_lxm := <tv_lxm & @main_verb_lxm & @'CC' & %@'BIND' & 
	arg_st![@refNP, @refNP|_].  

iv_lxm := <iv_lxm & @main_verb_lxm &  
	arg_st![@refNP].  

ppv_lxm := <ppv_lxm & @main_verb_lxm & 
	arg_st![@refNP, @'PP'|_]. 



%LEXICAL Rules for different verb classes

%============
%MOTION verbs
lex(Verb, <motion_verb & @iv_lxm & 
	  arg_st![@np(I)] & sem!restr![reln!Verb & moving!I])
:- 
   motion_verb(Verb).

%=============
%RESTING verbs
%J stood
lex(Verb, <rest_verb & @iv_lxm & 
	  arg_st![@np(J)] & sem!restr![reln!Verb & resting!I])
:- 
   rest_verb(Verb, intrans).

%J stood prep K
lex(Verb, <rest_verb & @ppv_lxm & 
	  arg_st![@np(J), @pp(loc,K)] & 
          sem!restr![reln!Verb & resting!J & locus!K])
:- 
   rest_verb(Verb, intrans).

%I stood J prep K
lex(Verb, <rest_verb & @tv_lxm & 
	  arg_st![@np(I), @np(J), @pp(loc,K)] & 
          sem!restr![reln!Verb & causer!I & resting!J & locus!K])
:- 
   rest_verb(Verb, trans).

%===============			
%FOLLOWING verbs	   
lex(Verb, <follow_verb & @tv_lxm & 
               arg_st![@np(I), @np(J)] &
               sem!restr![reln!Verb & moving!I & locus!J])
:- 
   follow_verb(Verb).

%============
%ARRIVE verbs	   

lex(Verb, <arrive_verb & @tv_lxm & 
               arg_st![@np(I), @np(J)] &
               sem!restr![reln!Verb & moving!I & locus!J])
:- 
   arrive_verb(Verb).

%================
%Verbs of GIVING

%subject is always donor
give_lxm := <give_verb & @tv_lxm & 
	    arg_st![@np(I)|_] &
	    sem!restr![donor!I].

%Verb X to Y
lex(Verb, @give_lxm & 
	   arg_st![_, @np(J), @pp(to,K)] &
           sem!restr![reln!Verb & gift!J & recipient!K])
:- 
   give_verb(Verb,to).

%Verb Y X
lex(Verb, @give_lxm & 
           arg_st![_, @np(K), @np(J)] &
           sem!restr![reln!Verb & gift!J & recipient!K])
:- 
   give_verb(Verb,ditrans).

%Verb X with Y
lex(Verb, @give_lxm & 
           arg_st![_, @np(K), @pp(with,J)] &
           sem!restr![reln!Verb & gift!J & recipient!K])
:- 
   give_verb(Verb,with).

%==================
%Verbs of AFFECTING

affect_lxm := <affect_verb & 
	    arg_st![@np(I)|_] &
	    sem!restr![agent!I].


lex(Verb, @affect_lxm & @tv_lxm & 
           arg_st![_, @np(J)] &
           sem!restr![reln!Verb & target!J])
:- 
   affect_verb(Verb,_,_,_).

%hit J with K
lex(Verb, @affect_lxm & @tv_lxm & 
           arg_st![_, @np(J), @pp(Prep,K)] &
           sem!restr![reln!Verb & target!J & manipulated!K])
:- 
   affect_verb(Verb,Prep,_,_).

%hit K against J
lex(Verb, @affect_lxm & @tv_lxm & 
           arg_st![_, @np(K), @pp(Prep,J)] &
           sem!restr![reln!Verb & target!J & manipulated!K])
:- 
   affect_verb(Verb, _, Prep,_).

lex(Verb, @affect_lxm & @ppv_lxm &
           arg_st![_, @pp(at,J)] &
           sem!restr![reln!Verb & target!J])
:- 
   affect_verb(Verb,_,_,at).

%============
%BUILD verbs

build_lxm := <build_verb & @tv_lxm & 
	    arg_st![@np(I)|_] &
	    sem!restr![agent!I].

lex(Verb, @build_lxm & 
           arg_st![_, @np(J), @pp(with,K)] &
           sem!restr![reln!Verb & product!J & manipulated!K])
:- 
   build_verb(Verb).

%V Y into X
lex(Verb, @build_lxm & 
           arg_st![_, @np(K), @pp(into,J)] &
           sem!restr![reln!Verb & product!J & manipulated!K])
:- 
   build_verb(Verb).

%V X
lex(Verb, @build_lxm &
           arg_st![_, @np(J)] &
           sem!restr![reln!Verb & product!J])
:- 
   build_verb(Verb).

%===============
%CORPOREAL verbs

corporeal_lxm := <corporeal_verb & 
	    arg_st![@np(I)|_] &
	    sem!restr![human!I].

lex(Verb, @corporeal_lxm & @iv_lxm & 
	   sem!restr![reln!Verb])
:- 
   corporeal_verb(Verb, intrans).

lex(Verb, @corporeal_lxm& @tv_lxm & 
           arg_st![_, @np(J)] &
           sem!restr![reln!Verb & substance!J])
:- 
   corporeal_verb(Verb, trans).

lex(Verb, @corporeal_lxm & @ppv_lxm & 
           arg_st![_, @pp(Prep, J)] &
           sem!restr![reln!Verb & thing!J])
:- 
   corporeal_verb(Verb, Prep).

lex(Verb, <corporeal_verb & @tv_lxm & 
                 arg_st![@np(I), @np(J)] &
                 sem!restr![reln!Verb & causer!I & human!J])
:- 
   corporeal_verb(Verb, caus).


%===============
%ATTENTION verbs

attention_lxm := <attention_verb & 
	    arg_st![@np(I)|_] &
	    sem!restr![perceiver!I].

lex(Verb, @attention_lxm & @tv_lxm & 
           arg_st![_, @np(J)] &
           sem!restr![reln!Verb & impression!J])
:- 
   attention_verb(Verb, trans).

lex(Verb, @attention_lxm & @iv_lxm & 
          sem!restr![reln!Verb])
:- 
   attention_verb(Verb, intrans).

%causative use, for 'show'
lex(Verb, <attention_verb & @tv_lxm & 
          (arg_st![@np(I), @np(J), @pp(to, K)] or
           arg_st![@np(I), @np(K), @np(J)]) &
          sem!restr![reln!Verb & causer!I & perceiver!K & impression!J])
:- 
   attention_verb(Verb, caus).

%=============
%WEATHER verbs
lex(Verb, <weather_verb & @main_verb_lxm & 
          arg_st![syn!head!form!it] &
          sem!restr![reln!Verb])
:- 
   weather_verb(Verb).

%=================
%Verbs of THINKING

think_lxm := <think_verb & @main_verb_lxm & 
	    arg_st![sem!(index!I & mode!ref)|_] &
	    sem!restr![cogitator!I].

lex(Verb,  @think_lxm &
           arg_st![_, @finclause(J)] &
           sem!restr![reln!Verb & thought!J])
:- 
   think_verb(Verb, fin).

lex(Verb, @sor_lxm & @think_lxm & 
          arg_st![_,  @accnp(_), 
                  syn!head!form!to & sem!index!J] &
          sem!restr![reln!Verb & thought!J])
:- 
   think_verb(Verb, sor).

lex(Verb, @think_lxm & 
          arg_st![_, @'NP',
                  syn!head!pred!+ & sem!index!J] &
          sem!restr![reln!Verb & thought!J])
:- 
   think_verb(Verb, smallclause).

lex(Verb, @think_lxm & @tv_lxm & 
          arg_st![_, @refNP & sem!index!J] &
          sem!restr![reln!Verb & cogitator!I & thought!J])
:- 
   think_verb(Verb, trans).

%===============
%Verbs of LIKING
lex(Verb, <like_verb & @tv_lxm & 
          arg_st![@np(I), @np(J)] &
          sem!restr![reln!Verb & experiencer!I & stimulus!J])
:- 
   like_verb(Verb).

%===============================
%Verbs of ANNOYING - Dixon 159ff
lex(Verb, <annoy_verb & @tv_lxm & 
          arg_st![@np(J), @np(I)] &
          sem!restr![reln!Verb & experiencer!I & stimulus!J])
:- 
   annoy_verb(Verb).

%for the extraposed variant - it annoys me that ...
lex(Verb, @main_verb_lxm & 
          arg_st![@'NP' & syn!head!form!it, 
                  @accnp(K) & sem!mode!ref, 
                  @finclause(I)] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit & experiencer!K
                 & stimulus!I]))
:-
   annoy_verb(Verb).

%and for it amuses me to...
lex(Verb, @main_verb_lxm & 
          arg_st![@'NP' & syn!head!form!it, 
                  @accnp(K) & sem!mode!ref, 
                  syn!head!form!to & sem!index!I & syn!val!spr![_Subj]] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit & experiencer!K
                 & stimulus!I]))
:-
   annoy_verb(Verb).



%=================
%Verbs of SPEAKING

speaking_lxm := <speaking_verb & 
		 arg_st![sem!(index!I & mode!ref)|_] &
		 sem!restr![speaker!I].

%said that 
lex(Verb, @speaking_lxm & @tv_lxm & 
           arg_st![_, @np(J), @finclause(K)] &
           sem!restr![reln!Verb & addressee!J & message!K])
:- 
   speaking_verb(Verb, fin).


%tell NP of/about
lex(Verb, @speaking_lxm & @tv_lxm & 
           arg_st![_, @np(J), (@pp(of,K) or @pp(about,K))] &
           sem!restr![reln!Verb & addressee!J & message!K])
:- 
   speaking_verb(Verb, of).


%reported NP (eg, the information) to NP
lex(Verb, @speaking_lxm & @tv_lxm & 
          arg_st![_, @np(K), @pp(to,J)] &
          sem!restr![reln!Verb &  addressee!J & message!K])
:- 
   speaking_verb(Verb, fin, to).

%report NP
lex(Verb, @speaking_lxm & @tv_lxm & 
          arg_st![_, @np(K)] &
          sem!restr![reln!Verb & message!K])
:- 
   speaking_verb(Verb, fin, to).

%report that
lex(Verb, @speaking_lxm & @main_verb_lxm &
          arg_st![_, @finclause(K)] &
          sem!restr![reln!Verb & message!K])
:- 
   speaking_verb(Verb, fin, Prep).

%report to NP that
lex(Verb, @speaking_lxm & @ppv_lxm &
          arg_st![_, @pp(to,J), @finclause(K)] &
          sem!restr![reln!Verb & addressee!J & message!K])
:- 
   speaking_verb(Verb, fin, to).

%talk to J about K / about K with J
lex(Verb, @speaking_lxm & @ppv_lxm & 
          arg_st!([_, @pp(Prep1,J), @pp(Prep2,K)] or
		  [_, @pp(Prep2,K), @pp(Prep1,J)])   &
          sem!restr![reln!Verb & addressee!J & message!K])
:- 
   speaking_verb(Verb, Prep1, Prep2).

%talk to J
lex(Verb, @speaking_lxm & @ppv_lxm & 
          arg_st![_, @pp(Prep1,J)] &
          sem!restr![reln!Verb & addressee!J])
:- 
   speaking_verb(Verb, Prep1, Prep2).

%talk about K
lex(Verb, @speaking_lxm & @ppv_lxm & 
          arg_st![_, @pp(Prep2,K)] &
          sem!restr![reln!Verb & message!K])
:- 
   speaking_verb(Verb, Prep1, Prep2).


%================
%Sentential verbs

%Extraposition
lex(Verb, @extrap_lxm & 
          arg_st![@'NP' & syn!head!form!it, @finclause(I)] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit & arg!I]))
:-
   sent_verb(Verb, _, extrap).    

%variant with a 'to' experiencer phrase (Arbiter)
lex(Verb, @extrap_lxm & 
          arg_st![@'NP' & syn!head!form!it, @pp(to,E), @finclause(I)] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit & arg!I & arbiter!E]))
:-
   sent_verb(Verb, _, extrap).    

%Subject-to-subject raising
lex(Verb, @srv_lxm & @main_verb_lxm & 
          arg_st![@'NP', syn!head!form!Form & sem!index!I] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit & arg!I]))
:-
   sent_verb(Verb, Form, _). 

%variant with Arbiter - only with extraposition-allowing verbs, I think
lex(Verb, @main_verb_lxm & @ssr &	
          arg_st![@'NP', @pp(to,E), syn!head!form!Form & sem!index!I] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit & arg!I & arbiter!E]))
:-
   sent_verb(Verb, Form, extrap). 


%Following is based on Pollard-Sag, not Dixon
%====================
%Verbs of INFLUENCING
lex(Verb, @main_verb_lxm & %@tv_lxm & 
          arg_st![@np(I), @accnp(J), 
                  syn!head!form!Form & sem!index!K & syn!val!spr![sem!index!J]] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit 
			 & influence!I & influenced!J & soa!K]))
:-
   influence_verb(Verb, Form). 


%===================
%Verbs of COMMITTING

%controller is always the committor
comm_control := 
          (arg_st![_, syn!val!spr![sem!index!I]] or
	   arg_st![_, _, syn!val!spr![sem!index!I]]) &
          sem!(restr![committor!I|_]).

%X promises to V
lex(Verb, @main_verb_lxm & @comm_control &
          arg_st![@np(I), 
                  syn!head!form!Form & sem!index!J] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit 
			 & committor!I & soa!J]))
:-
   commitment_verb(Verb, Form, intrans). 

%X promises me to V
lex(Verb, @main_verb_lxm & @comm_control &
          arg_st![@np(I), @accnp(J), 
                  syn!head!form!Form & sem!index!K] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit 
			 & committor!I & commissee!J & soa!K]))
:-
   commitment_verb(Verb, Form, trans). 

%==================
%Verbs of ORIENTING
lex(Verb, @main_verb_lxm & 
          arg_st![@np(I), 
                  syn!head!form!Form & sem!index!J & syn!val!spr![sem!index!I]] &
          sem!(index!Sit & restr![reln!Verb & sit!Sit 
			 & experiencer!I & soa!J]))
:-
   orientation_verb(Verb, Form). 





%Verb lexemes

motion_verb(walk).
motion_verb(crawl).
motion_verb(run).
motion_verb(stroll).
motion_verb(march).
motion_verb(return).

arrive_verb(approach).

rest_verb(crouch, intrans).

rest_verb(stand, (trans or intrans)).
rest_verb(sit, (trans or intrans)).

rest_verb(put, trans).
rest_verb(place, trans).
rest_verb(store, trans).

follow_verb(follow).
follow_verb(track).
follow_verb(lead).
follow_verb(precede).

%to = V NP to-PP is possible
%ditran = V NP NP is possible
%with = the with-alternant is possible.
give_verb(give, (to or ditrans)).
give_verb(lend, (to or ditrans)).
give_verb(supply, (to or ditrans or with)).
give_verb(present, (to or with)).
give_verb(bribe, with).
give_verb(contribute, to).


%2nd arg is for with variant, 
%3rd arg states if hit X against Y (etc) is possible
%4th arg states if kick at Y (etc) is possible
affect_verb(hit, with, (on or against), at).
affect_verb(kick, with, none, at).
affect_verb(touch, with, against, none).
affect_verb(nudge, with, none, none).
affect_verb(wrap, (in or with), around, none).

build_verb(build).
build_verb(bake).

%trans = subj of intrans is subj of trans 
%caus  = subj of intrans is obj  of trans
corporeal_verb(laugh, (intrans or at)).
corporeal_verb(dream, (intrans or of)).
corporeal_verb(eat, (trans or intrans)).
corporeal_verb(wake, (caus or intrans)).
corporeal_verb(die, intrans).
corporeal_verb(kill, caus).

%clausal = takes compl clause (eg 'heard that ...')
attention_verb(see, (trans or intrans)).
attention_verb(hear, (trans or intrans)).
attention_verb(notice, (trans or intrans)).
attention_verb(show, caus).

weather_verb(rain).
weather_verb(snow).
weather_verb(hail).

%takes finite clause or small clause or subject-to-object raising
think_verb(think, (fin or smallclause)).
think_verb(guess, fin).
think_verb(believe, (fin or sor)).
think_verb(consider, (fin or sor or smallclause)).
think_verb(assume, (fin or sor)).
think_verb(know, (fin or sor)).
think_verb(learn, trans).

like_verb(like).
like_verb(love).
like_verb(hate).

annoy_verb(annoy).
annoy_verb(amuse).

speaking_verb(inform, (fin or of)).
speaking_verb(remind, (fin or of)).
speaking_verb(tell, (fin or of)).
speaking_verb(report, fin, to).
speaking_verb(say, fin, to).
speaking_verb(mention, fin,  to).
speaking_verb(announce, fin, to).
speaking_verb(talk, (to or with), about).
speaking_verb(chat, (to or with), about).
speaking_verb(argue, with, about).

sent_verb(seem, to, extrap).
sent_verb(appear, to, extrap).
sent_verb(look, to, extrap).
sent_verb(keep, prp, none).
sent_verb(continue, (prp or to), none).

influence_verb(persuade, to).
influence_verb(force, to).
influence_verb(convince, to).
influence_verb(encourage, to).

commitment_verb(promise, to, (trans or intrans)).
commitment_verb(refuse, to, intrans).

orientation_verb(wish, to).
orientation_verb(expect, to).
orientation_verb(like, to).
orientation_verb(prefer, to).



% Infinitive (Base) Lexical Rule
lex(VerbInf, <word & @'ARP' &
        syn!(Syn & head!form!inf) &
	arg_st!Arg_St &
        sem!Sem)
:-
	lex(VerbInf, @verb_lxm &
        	syn!Syn &
		arg_st!Arg_St &
	        sem!Sem).

% Present 3sg Lexical Rule
lex(Verb3sg, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!(case!nom & agr!(3&sg))]) &
	arg_st!Arg_St &
        sem!(index!Sit & mode!prop & restr![Pred,@t_overlap(Sit)]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![Pred])),
	morph_3sg(VerbBase, Verb3sg).


lex(Verb3sg, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!(case!nom & agr!(3&sg))]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![@t_overlap(Sit)]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb  & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])),
	morph_3sg(VerbBase, Verb3sg).

% Morphological Function for 3rd Singular Present
morph_3sg(be, is) :- !.
morph_3sg(have, has) :- !.
morph_3sg(VerbBase, Verb3sg) :-
	atomic(VerbBase),
	name(VerbBase, SpellBase),
	reverse(SpellBase, RevBase),
	reverse_3sg(RevBase, Rev3sg),
	reverse(Rev3sg, Spell3sg),
	name(Verb3sg, Spell3sg).

reverse_3sg([0'o|Rev], [0's,0'e,0'o|Rev]) :- !.
reverse_3sg([0'y,0'e|Rev], [0's,0'y,0'e|Rev]) :- !.
reverse_3sg([0'y,V|Rev], [0's,0'y,V|Rev]) :- vowel(V), !.
reverse_3sg([0'y|Rev], [0's,0'e,0'i|Rev]) :- !.
reverse_3sg([0's|Rev], [0's,0'e,0's|Rev]) :- !.
reverse_3sg([0'h,0'c|Rev], [0's,0'e,0'h,0'c|Rev]) :- !.   %for 'approaches'
reverse_3sg([0'h,0's|Rev], [0's,0'e,0'h,0's|Rev]) :- !.   %for 'wishes'
reverse_3sg([0'x|Rev], [0's,0'e,0'x|Rev]) :- !.
reverse_3sg(Rev, [0's|Rev]).



% Present Non-3sg Lexical Rule
lex(VerbNon3sg, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!(case!nom & agr!~(3&sg))]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![Pred,@t_overlap(Sit)]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![Pred])),
	morph_non3sg(VerbBase, VerbNon3sg).

lex(VerbNon3sg, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!(case!nom & agr!~(3&sg))]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![@t_overlap(Sit)]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])),
	morph_non3sg(VerbBase, VerbNon3sg).

% Morphological Function for Non-3rd Singular Present
morph_non3sg(be, are) :- !.
morph_non3sg(VerbBase, VerbBase).

% Past Lexical Rule
lex(VerbPast, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!case!nom]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![Pred, @t_precede(Sit)]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![Pred])),
	morph_past(VerbBase, VerbPast).

lex(was, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!(case!nom & agr!(3&sg))]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![@t_precede(Sit)]))
:-
	lex(be, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])).

lex(were, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!(case!nom & agr!~(3&sg))]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![@t_precede(Sit)]))
:-
	lex(be, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])).

lex(did, <word & @'ARP' &
        syn!(head!(<verb & form!fin & aux!Aux & pred!- & mod!Mod) &
             val!spr![syn!head!case!nom]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![@t_precede(Sit)]))
:-
	lex(do, @auxv_lxm &
        	syn!head!(<verb & form!fin & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])).

% Morphological Function for Past
morph_past(go, went) :- !.
morph_past(stand, stood) :- !.
morph_past(build, built) :- !.
morph_past(think, thought) :- !.
morph_past(keep, kept) :- !.
morph_past(eat, ate) :- !.
morph_past(give, gave) :- !.
%morph_past(get, got) :- !.
morph_past(consider, considered) :- !.
morph_past(hear, heard) :- !.
morph_past(lend, lent) :- !.
morph_past(have, had) :- !.
morph_past(buy, bought) :- !.
morph_past(hit, hit) :- !.
morph_past(know, knew) :- !.
morph_past(put, put) :- !.
morph_past(run, ran) :- !.
morph_past(say, said) :- !.
morph_past(see, saw) :- !.
morph_past(sit, sat) :- !.
morph_past(swim, swam) :- !.
morph_past(tell, told) :- !.
morph_past(wake, woke) :- !.
morph_past(write, wrote) :- !.
morph_past(VerbBase, VerbPast) :-
	atomic(VerbBase),
	name(VerbBase, SpellBase),
	reverse(SpellBase, RevBase),
	reverse_past(RevBase, RevPast),
	reverse(RevPast, SpellPast),
	name(VerbPast, SpellPast).

reverse_past([0'w,V|Rev], [0'd,0'e,0'w,V|Rev]) :-  vowel(V), !. %for follow
reverse_past([0'y,V|Rev], [0'd,0'e,0'y,V|Rev]) :-  vowel(V), !. %for annoy
reverse_past([C,V,W|Rev], [0'd,0'e,C,V,W|Rev]) :- vowel(V), vowel(W),cons(C), !.
reverse_past([C,V|Rev], [0'd,0'e,C,C,V|Rev]) :-  vowel(V), cons(C), !.
reverse_past([0'y|Rev], [0'd,0'e,0'i|Rev]) :- !.
reverse_past([0'e|Rev], [0'd,0'e|Rev]) :- !.
reverse_past(Rev, [0'd,0'e|Rev]).

% Present Participle Lexical Rule
lex(VerbPRP, <word & @'ARP' &
        syn!head!(<verb & form!prp & aux!Aux & pred!+ & mod!Mod) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![Pred & aspect!prog]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![Pred])),
	morph_PRP(VerbBase, VerbPRP).

lex(being, <word & @'ARP' &
        syn!(head!(<verb & form!prp & aux!Aux & pred!+ & mod!Mod) &
             val!comps![syn!head!form!pass]) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![]))
:-
	lex(be, @verb_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])).



% Morphological Function for Present Participle
morph_PRP(VerbBase, VerbPRP) :-
	atomic(VerbBase),
	name(VerbBase, SpellBase),
	reverse(SpellBase, RevBase),
	reverse_PRP(RevBase, RevPRP),
	reverse(RevPRP, SpellPRP),
	name(VerbPRP, SpellPRP).

reverse_PRP([0'e,0'e|Rev], [0'g,0'n,0'i,0'e,0'e|Rev]) :- !.
reverse_PRP([0'e,0'i|Rev], [0'g,0'n,0'i,0'y|Rev]) :- !.    %'dying'
reverse_PRP([0'e,V|Rev], [0'g,0'n,0'i,V|Rev]) :-  vowel(V), !.
reverse_PRP([0'w,V|Rev], [0'g,0'n,0'i,0'w,V|Rev]) :-  vowel(V), !. %for follow
reverse_PRP([0'y,V|Rev], [0'g,0'n,0'i,0'y,V|Rev]) :-  vowel(V), !.
reverse_PRP([C,V,W|Rev], [0'g,0'n,0'i,C,V,W|Rev]) :-  vowel(V),
			                      vowel(W), !. %to handle 'eating'
reverse_PRP([C,V|Rev], [0'g,0'n,0'i,C,C,V|Rev]) :-  vowel(V), !.
reverse_PRP([0'e|Rev], [0'g,0'n,0'i|Rev]) :- !.
reverse_PRP(Rev, [0'g,0'n,0'i|Rev]).

% Past Participle Lexical Rule
lex(VerbPSP, <word & @'ARP' &
        syn!head!(<verb & form!psp & aux!Aux & pred!- & mod!Mod) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![Pred]))
:-
	lex(VerbBase, @verb_lxm &
        	syn!head!(<verb & form!inf & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![Pred])),
	morph_PSP(VerbBase, VerbPSP). 

lex(been, <word & @'ARP' &
        syn!head!(<verb & form!psp & aux!Aux & pred!- & mod!Mod) &
	arg_st!Arg_St &
        sem!(index!Sit & restr![]))
:-
	lex(be, @verb_lxm &
        	syn!head!(<verb & form!inf & mod!Mod) &
		arg_st!Arg_St &
	        sem!(index!Sit & restr![])).

% Morphological Function for Past Participle (and Passive)
morph_PSP(stand, stood) :- !.
morph_PSP(give, given) :- !.
morph_PSP(consider, considered) :- !.
morph_PSP(hear, heard) :- !.
morph_PSP(lend, lent) :- !.
morph_PSP(build, built) :- !.
morph_PSP(think, thought) :- !.
morph_PSP(have, had) :- !.
morph_PSP(buy, bought) :- !.
morph_PSP(eat, eaten) :- !.
morph_PSP(hit, hit) :- !.
morph_PSP(know, known) :- !.
morph_PSP(put, put) :- !.
morph_PSP(run, run) :- !.
morph_PSP(say, said) :- !.
morph_PSP(see, seen) :- !.
morph_PSP(sit, sat) :- !.
morph_PSP(swim, swum) :- !.
morph_PSP(tell, told) :- !.
morph_PSP(wake, woken) :- !.
morph_PSP(write, written) :- !.
morph_PSP(VerbBase, VerbPSP) :-
	atomic(VerbBase),
	name(VerbBase, SpellBase),
	reverse(SpellBase, RevBase),
	reverse_PSP(RevBase, RevPSP),
	reverse(RevPSP, SpellPSP),
	name(VerbPSP, SpellPSP).

reverse_PSP([0'w,V|Rev], [0'd,0'e,0'w,V|Rev]) :-  vowel(V), !. %for follow
reverse_PSP([0'y,V|Rev], [0'd,0'e,0'y,V|Rev]) :-  vowel(V), !. %for annoy
reverse_PSP([C,V,W|Rev], [0'd,0'e,C,V,W|Rev]) :- vowel(V), vowel(W), cons(C), !.
reverse_PSP([C,V|Rev], [0'd,0'e,C,C,V|Rev]) :-  vowel(V), cons(C), !.
reverse_PSP([0'o|Rev], [0'e,0'n,0'o|Rev]) :- !.
reverse_PSP([0'y,Vowel|Rev], [0'd,0'e,0'y,Vowel|Rev]) :- vowel(Vowel), !.
reverse_PSP([0'y|Rev], [0'd,0'e,0'i|Rev]) :- !.
reverse_PSP([0'e|Rev], [0'd,0'e|Rev]) :- !.
reverse_PSP(Rev, [0'd,0'e|Rev]).

%entries for `rumoured' (which occurs in passive only) - PB, 8/1/02

lex(rumoured, <word & @'ARP' & @ssr &
        syn!head!(<verb & form!pass & pred!+ & mod!none) &
	arg_st![Subj, syn!head!form!to & sem!index!J] &
        sem!(index!Sit & restr![reln!rumour & thought!J & sit!Sit])).



% Passive Lexical Rule
lex(VerbPassive, <word & @'ARP' &
        syn!head!(<verb & form!pass & aux!Aux & pred!+ & mod!Mod) &
	arg_st![@np(Obj)|Comps] &
        sem!Sem)
:-
	lex(VerbBase, @main_verb_lxm & %@tv_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st![@np(Subj),@np(Obj)|Others] &
	        sem!Sem),
	append(Others,[@pp(by,Subj)],Comps),
	morph_PSP(VerbBase, VerbPassive).

%for short passives -- PB 16/2/00
lex(VerbPassive, <word & @'ARP' &
        syn!head!(<verb & form!pass & aux!Aux & pred!+ & mod!Mod) &
	arg_st![@np(Obj)|Comps] &
        sem!Sem)
:-
	lex(VerbBase, @main_verb_lxm & %@tv_lxm &
        	syn!head!(<verb & form!inf & aux!Aux & mod!Mod) &
		arg_st![@np(Subj),@np(Obj)|Comps] &
	        sem!Sem),
	morph_PSP(VerbBase, VerbPassive).

not(P) :- call(P), !, fail.			%C&M p72.
not(P).

vowel(0'a). vowel(0'e). vowel(0'i). vowel(0'o). vowel(0'u).

cons(X) :- not(vowel(X)).			%PB 23/3/00.

/*******************************************************/
/*       Interface for GramKit parser/generator        */
/*******************************************************/

lookup_word(Word, <word & phon![Phon|P]-P & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I &  restr![Pred1,Pred2|R]-R))
:-
	lex(Word, <word & phon![Phon] & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I & restr![Pred1,Pred2])).

lookup_word(Word, <word & phon![Phon|P]-P & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I & restr![Pred|R]-R))
:-
	lex(Word, <word & phon![Phon] & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I & restr![Pred])).

lookup_word(Word, <word & phon![Phon|P]-P & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I & restr!R-R))
:-
	lex(Word, <word & phon![Phon] & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I & restr![])).

lookup_term(Pred, Pform, Prep & sem!index!Tag)
:-
	lex(_HeadWord, <word & syn!val!comps![@pp(Pform,Tag)] &
	               sem!restr![Pred|_]),
	empty_sem(Pform, Prep).

lookup_term(Pred, Pform, Prep &sem!index!Tag)
:-
	lex(_HeadWord, <word & syn!val!comps![_,@pp(Pform,Tag)] &
	               sem!restr![Pred|_]),
	empty_sem(Pform, Prep).

lookup_term(Pred1, Word, <word & phon![Phon|P]-P & syn!Syn & arg_st!Arg_St &
		         sem!(mode!M & index!I &  restr![Pred1,Pred2|R]-R))
:-
	lex(Word, <word & phon![Phon] & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I &  restr![Pred1,Pred2])).

lookup_term(Pred, Word, <word & phon![Phon|P]-P & syn!Syn & arg_st!Arg_St &
		        sem!(mode!M & index!I  & restr![Pred|R]-R))
:-
	lex(Word, <word & phon![Phon] & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I &  restr![Pred])).

empty_sem(Word, <word & phon![Phon|P]-P & syn!Syn & arg_st!Arg_St &
		sem!(mode!M & index!I &  restr!R-R))
:-
	lex(Word, <word & phon![Phon] & syn!Syn & arg_st!Arg_St &
		  sem!(mode!M & index!I &  restr![])).


semantics(sem!(index!Index &  restr!Restr-[]), Restr).

string(phon!Phon-[], Phon).

/*******************************************************/
/*      Interface for tree formatter/printer           */
/*******************************************************/

format_tree_node(In, Out) :-
	node_format(In, Out).

node_format(@'D' ,  'D').

node_format(@'N',   'N').
node_format(@'NOM', 'NOM').
node_format(@'NP',  'NP').

node_format(@'COMP', 'COMP').				    %PB 16/2/00
node_format(@'SBAR'  & syn!head!form!Form, 'SBAR'(Form)).   %PB 16/2/00
node_format(@'VPBAR' & syn!head!form!to,   'VP(to)').

node_format(@'P',  'P').
node_format(@'PP', 'PP').

node_format(@'A', 'A').
node_format(@'AP', 'AP').

node_format(@'ADV',  'ADV').
node_format(@'ADVP', 'ADVP').

node_format(@'V'  & syn!head!form!Form, 'V'(Form)).
node_format(@'VP' & syn!head!form!Form, 'VP'(Form)).

node_format(@'S'  & syn!head!form!Form & sem!mode!prop, 'S'(Form, prop)).
node_format(@'S'  & syn!head!form!Form & sem!mode!dir, 'S'(Form, dir)).
node_format(@'S'  & syn!head!form!Form & sem!mode!ques, 'S'(Form, ques)).

node_format(<word & syn!head!<conj, 'Conj').
node_format(<phrase & syn!head!<conj, 'ConjP').

node_format(In, Functor) :- functor(In, Functor, _).

/*******************************************************/
/*      Interface for semantics printer                */
/*******************************************************/

gensym_sem(restr!Preds-[]) :-	% MRS structure
	gensym_refs(Preds).
gensym_sem([Rel|Rels]) :-	% MRS list (Liszt)
	gensym_refs([Rel|Rels]).

gensym_refs([]).
gensym_refs([Rel|Rels]) :-
	gensym_ref(Rel),
	gensym_refs(Rels).

gensym_ref(name!Name & named!Ref) :- gensym_init(Name, Ref), !.
gensym_ref(reln!Reln & inst!Ref) :-  gensym_init(Reln, Ref), !.
gensym_ref(reln!Reln & sit!Ref) :-   gensym_init(Reln, Ref), !.
gensym_ref(_).

gensym_init(Lexeme, Var) :-
        atom(Lexeme),
        var(Var),
        name(Lexeme, [L|_]),
        (L > 90 -> C is L - 32
                 ; C = L),
        name(Root, [C]),
        gensym(Root, Var).

/*******************************************************/
/* gensym/2                  (from Clocksin & Mellish) */
/*******************************************************/

gensym(Root,Atom) :-
        getNum(Root,Num),
        name(Root,Name1),
        numeral(Num,Name2),
        append(Name1,Name2,Name),
        name(Atom,Name).

getNum(Root,Num) :-
        retract(current_num(Root,Num1)),!,
        Num is Num1+1,
        asserta(current_num(Root,Num)).
getNum(Root,1) :- asserta(current_num(Root,1)).

numeral(Int,List) :- numeral(Int,[],List).
numeral(I,Sofar,[C|Sofar]) :-
        I < 10,!, C is I + 48.
numeral(I,Sofar,List) :-
        Tophalf is I//10,        % '//' for integer in Sicstus.
        Bothalf is I mod 10,
        C is Bothalf+48,
        numeral(Tophalf,[C|Sofar],List).

/*******************************************************/
/*            End of GramKit Grammar                   */
/*******************************************************/