%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  File:  grammar6.pl
%
%  Course:  HPSG Grammars in ALE
%
%  Purpose:  1.  Introduces the features "inv", "aux", and "vform"
%            2.  Adds lexical entries for auxiliaries "can" and "does"
%            3.  Adds lexical entries for base forms - "like", etc
%            4.  Introduces the head-subject-complement schema
%            5.  Implements detp, s, and vp macros
%
%  Parses:   kim does like sandy
%            does kim like sandy
%            can kim give sandy the book
%            kim does believe sandy likes books
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%**********************  Type Hierarchy

bot cons bot.

bot sub [sign,list,cat,head,vform,boolean,mod_synsem,  % new types
         loc,nonloc,cont].                             % added

mod_synsem sub [synsem,none].                % as in the book

synsem sub [pre_mod_synsem, post_mod_synsem]  % not as in the book!
   intro [loc:loc,
          nonloc:nonloc].

pre_mod_synsem sub [].
post_mod_synsem sub [].
none sub [].

loc sub []
   intro [cat:cat,
          cont:cont].            % cont included as a placeholder

cont sub [].

nonloc sub [].

sign sub []
   intro [synsem:synsem].

cat sub []
   intro [head:head,
          subj:list,
          comps:list,
          spr:list].
                                
head sub [subst,func].
                      
subst sub [noun,verb,adj]             % adj added, and two new
    intro [prd:boolean,               % features to handle
           mod:mod_synsem].           % modifiers

func sub [mark,det]   
  intro [spec:synsem].

noun sub [].
det sub [].
adj sub [].
mark sub [].

verb sub []
  intro [vform:vform,
         aux:boolean,
         inv:boolean].

boolean sub [yes,no].

yes sub [].
no sub [].

vform sub [fin,bse].

fin sub [].
inf sub [].
bse sub [].

list sub [e_list,ne_list].

ne_list sub []
   intro [hd:bot,
	  tl:list].

e_list sub [].

%%%**********************  Macros

np macro                        
  loc:cat:(head:noun,         % all macros include "loc" feature now      
           comps:[],
           subj:[],
           spr:[]).

nbar macro                     
  loc:cat:(head:noun,                 
           comps:[],
           subj:[],
           spr:[_]).

detp macro                    
  loc:cat:(subj:[],
           comps:[],
           spr:[],
           head:det).

s macro
  loc:cat:(head:verb,
           comps:[],
           subj:[]).

vp macro                      
  loc:cat:(head:verb,
           comps:[],
	   subj:[_]).

%%%**********************  Lexical Entries

%%**********  Nouns

kim ---> synsem:(@ np,
                 loc:cat:head:mod:none).     % "mod:none" added to all
                                             %  substantives except adjuncts
sandy ---> synsem:(@ np,
                   loc:cat:head:mod:none).

books ---> synsem:(@ np,
                   loc:cat:head:mod:none).

book ---> synsem:(@ nbar,
                  loc:cat:(head:mod:none,
                           spr:[@ detp])).           % "detp" macro used here

%%**********  Adjectives

red ---> (synsem:loc:cat:(head:(adj,                   % new entry
                                mod:(pre_mod_synsem,
                                     @ nbar)),
                          spr:[],
                          subj:[],
                          comps:[])).

%%**********  Adverbs

definitely ---> (synsem:loc:cat:(head:(adj,          % and another
                                       mod:(@ vp)),
                                 spr:[],
                                 subj:[],
                                 comps:[])).

%%**********  Determiners

the ---> 
  synsem:loc:cat:(head:(det,
                        spec:(@ nbar)),
                  spr:[],
                  subj:[], 
                  comps:[]).

%%**********  Main Verbs

snored ---> 
  synsem:loc:cat:(head:(verb,                % all verbs include
	                vform:fin,           % the new features
                        mod:none,
                        aux:no,
                        inv:no),
                  subj:[@ np],
                  comps:[]).

snore ---> (synsem:loc:cat:(head:(verb,
                                  mod:none,
                                  vform:bse,
                                  aux:no,
                                  inv:no),
                            subj:[@ np],
                            comps:[])).

likes ---> (synsem:loc:cat:(head:(verb,
                                  mod:none,                            
                                  vform:fin,
                                  aux:no,
                                  inv:no),
                            subj:[@ np],
                            comps:[@ np])).

like ---> (synsem:loc:cat:(head:(verb,
                               mod:none,
                               vform:bse,
                               aux:no,
                               inv:no),
                           subj:[@ np],
                           comps:[@ np])).

gave ---> (synsem:loc:cat:(head:(verb,
                                 mod:none,
                                 vform:fin,
                                 aux:no,
                                 inv:no),
                           subj:[@ np],
                           comps:[@ np,@ np])).

give ---> (synsem:loc:cat:(head:(verb,
                                 mod:none,
                                 vform:bse,
                                 aux:no,
                                 inv:no),
                           subj:[@ np],
                           comps:[@ np,@ np])).

believes ---> (synsem:loc:cat:(head:(verb,
                                     mod:none,
                                     vform:fin,
                                     aux:no,
                                     inv:no),
                               subj:[@ np],
                               comps:[@ s])).

believe ---> (synsem:loc:cat:(head:(verb,
                                     mod:none,
                                     vform:bse,
                                     aux:no,
                                     inv:no),
                               subj:[@ np],
                               comps:[@ s])).


%%**********  Auxiliary Verbs

can ---> (synsem:loc:cat:(head:(verb,
                              mod:none,
                              vform:fin,
                              aux:yes),
                          comps:[(@ vp,
                                  loc:cat:(subj:Subj,
                                           head:vform:bse))],
                          subj:Subj)).

does ---> (synsem:loc:cat:(head:(verb,
                              mod:none,
                              vform:fin,
                              aux:yes),
                          comps:[(@ vp,
                                  loc:cat:(subj:Subj,
                                           head:vform:bse))],
                          subj:Subj)).

%%%**********************  Grammmar Rules

subject_head rule        
(Mother, synsem:loc:cat:(spr:Spr,
                         subj:[], 
                         comps:[]))
===>
cat> (SubjDtr),  
goal> (sign_to_synsem(SubjDtr,SubjSynsem)),       % rules now have new 
cat> (HeadDtr, synsem:loc:cat:(spr:Spr,           % goals for nonlocal feature
                               subj:[SubjSynsem], % and marking principles
                               comps:[])),
% goal> (nonlocal_feature_principle(HeadDtr,[SubjDtr],Mother)),
goal> (head_feature_principle(Mother,HeadDtr)).

head_complement rule 
(Mother, synsem:loc:cat:(spr:Spr,
                         subj:Subjs,
                         comps:[]))
===>
cat> (HeadDtr, synsem:loc:cat:(spr:Spr,
                               subj:Subjs, 
                               comps:CompSynsems)),
goal> (list_sign_to_synsem(Comps,CompSynsems)),
cats> (Comps,ne_list),
% goal> (nonlocal_feature_principle(HeadDtr,Comps,Mother)),
goal> (head_feature_principle(Mother,HeadDtr)).

head_subject_complement rule
(Mother, synsem:loc:cat:(spr:[],
                         subj:[],
                         comps:[]))
===>
cat> (HeadDtr, synsem:loc:cat:(head:inv:yes,
                               subj:[SubjSynsem], 
                               comps:CompSynsems)),
goal> (list_sign_to_synsem(Comps,CompSynsems)),
cat> (SubjDtr),
goal> (sign_to_synsem(SubjDtr,SubjSynsem)),
cats> (Comps,ne_list),
% goal> (nonlocal_feature_principle(HeadDtr,[SubjDtr|Comps],Mother)),
goal> (head_feature_principle(Mother,HeadDtr)).

specifier_head rule
(Mother, synsem:loc:cat:(spr:[],              % has also goal for
                         subj:[],             % spec principle
                         comps:[]))
===>
cat> (SpecDtr,synsem:loc:cat:(spr:[],
                               subj:[],
                               comps:[])),
goal> (sign_to_synsem(SpecDtr,SpecSynsem)),
cat> (HeadDtr, synsem:loc:cat:(spr:[SpecSynsem],
                               subj:[], 
                               comps:[])),
% goal> (nonlocal_feature_principle(HeadDtr,[SpecDtr],Mother)),
goal> (head_feature_principle(Mother,HeadDtr)).

adjunct_head rule                                   
(Mother, synsem:loc:cat:(spr:Spr, 
                         subj:Subj, 
                         comps:[]))
===>
cat> (synsem:loc:cat:(head:mod:(Mod, pre_mod_synsem),
                      spr:[],
                      subj:[],
                      comps:[])),
cat> (HeadDtr,synsem:(Mod, 
                      loc:cat:(spr:Spr, 
                               subj:Subj, 
                               comps:[]))),
% goal> (nonlocal_feature_principle(HeadDtr,[AdjDtr],Mother)),
goal> (head_feature_principle(Mother,HeadDtr)).

head_adjunct rule                                   
(Mother, synsem:loc:cat:(spr:Spr, 
                         subj:Subj,
                         comps:[]))
===>
cat> (HeadDtr,synsem:(Mod,
                      loc:cat:(spr:Spr, 
                               subj:Subj, 
                               comps:[]))),
cat> (synsem:loc:cat:(head:mod:(Mod, post_mod_synsem),
                      spr:[],
                      subj:[],
                      comps:[])),
% goal> (nonlocal_feature_principle(HeadDtr,[AdjDtr],Mother)),
goal> (head_feature_principle(Mother,HeadDtr)).

%%%**********************  Universal Principles

head_feature_principle(synsem:loc:cat:head:Head,  
                       synsem:loc:cat:head:Head)  
     if true.                                     

%%%******** Initial version of the Non-Local Feature Principle


nonlocal_feature_principle(
      (synsem:nonloc:slash:Slash),
      (Dtrs),
      (synsem:nonloc:slash:MotherSlash))
    if  dtrs_slashes(Dtrs,[],DtrsSlash),
        append(Slash,DtrsSlash,MotherSlash).

dtrs_slashes([],Res,Res) if true.
dtrs_slashes([Cat|Rest],List,Res) 
  if cat_slash(Cat,Slash),
     append(Slash,List,NewList),
     dtrs_slashes(Rest,NewList,Res).

cat_slash(synsem:nonloc:slash:Slash,Slash) if true.


%%%******** Spec Principle


spec_principle((synsem:loc:cat:head:Head),synsem:HeadSynsem) if
  specp_act(Head,HeadSynsem).

specp_act(subst,_) if      % substantive head
  true.
specp_act(spec:X,X) if     % functional head
  true.

%%%**********************  Definite Constraints

sign_to_synsem(synsem:Synsem,Synsem) if true.        % new predicates

list_sign_to_synsem([],[]) if true.

list_sign_to_synsem([H|T],[S|R]) if
     sign_to_synsem(H,S),
     list_sign_to_synsem(T,R). 

append([],Xs,Xs) if
  true.
append([H|T1],L2,[H|T2]) if
  append(T1,L2,T2).

%%%**********************  End of File
