;; Alexander Gruenstein
;; Partial implementation of:
;; Jonathan Ginzburg and Ivan A. Sag, Interrogative Investigations, CSLI Publications, 2000.


;; TODO:
; typed lists 
; typed sets (currently using lists)

; issues, without signs-tosynsems function (see p34 of G&S)
; then I make DTRS an actual list of signs, rather than just
; synsems...i *think* this is all right, though it forces
; eg COMPS to take a SIGN

; SYNTACTIC types

feature-structure := *top*.

; TODO: note, don't force canon-ss because of the way
; my ARG-ST works
; also, have removed CONTEXT
sign := feature-structure &
	[ ORTH *list*,
	  SYNSEM synsem,
	  ROOT boolean /l - ].




lex-sign := sign &
	    [ ARG-ST *list*].

lexeme := lex-sign.


word := lex-sign.


synsem := feature-structure &
	  [ LOCAL local,
	   SLASH *list*,
	   WH *dlist*,
	   BCKGRND *list* ].

canon-ss := synsem.

noncan-ss := synsem.

pro-ss := noncan-ss &
	  [ LOCAL [ CAT.HEAD n & [ CASE acc ],
		    CONT reflexive & [INDEX ref]]].


gap-ss := noncan-ss &
	  [ LOCAL #1,
	    SLASH < #1 > ].


local := feature-structure &
	 [ CAT category,
	   CONT sem-obj,
	   STORE *dlist*].

category := feature-structure &
	    [ HEAD pos,
	      SUBJ *list*,
	      COMPS *list*,
	      SPR *list* ].

; note: SAL-UTT is a list of LOCAL objects
conx-obj := feature-structure & 
            [C-INDICES c-inds,
	     SAL-UTT *list*,
	     MAX-QUD question].

c-inds := feature-structure & 
	  [ C-SPKR index,
	    C-ADDR index,
	    U-LOC index].

boolean := feature-structure.
+ := boolean.
- := boolean.


verb := verbal & 
	[ AUX boolean,
	  POL boolean ].


pos := feature-structure &
       [ PRED boolean ].

verbal := pos &
	  [ VFORM vform,
	    IC boolean,
	    INV boolean,
	    MOD mod].



c := verbal.
v := verb.
g := verb.
d := pos &
     [ SPEC sem-obj ].
a := pos.
adv := pos.
nominal := pos.
p := nominal.
n := nominal &
     [ CASE case,
       AGR agr-cat].
det := pos.

vform := feature-structure.
clausal := vform.
fin := clausal.
inf := clausal & nonfin.
nonfin := vform.
base := nonfin.
part := nonfin.
prp := part.
pfp := part.
pas := part.
case := feature-structure.
nom := case.
acc := case.


; phrase types

; (4) Empty comps constraint (ECC)
; TODO: note, I've introduced HD-DTR here because it appears in clause constraints
; which are NOT below hd-ph.  This is an interesting multiple-inheritence issue
phrase := sign &
	  [ ARGS *list*,
	    SYNSEM.LOCAL.CAT.COMPS <>,
	    HD-DTR sign].


; HEADENESS



; (5) GHFP 
hd-ph := phrase  &
	 [ SYNSEM synsem /l #1,
	   HD-DTR [ SYNSEM synsem /l #1 ] ].

non-hd-ph := phrase.

;(6) 
; actually, this is too strict, since potentially there
; can be more arguments after the comps
hd-comp-ph := hd-ph & 
	      [HD-DTR #1 & 
		      word & 
		      [SYNSEM.LOCAL.CAT.COMPS #A],
	       ARGS [FIRST #1,
		     REST #A]].


; (7)
hd-subj-ph := hd-ph & 
	      [SYNSEM.LOCAL.CAT.SUBJ <>,
	       ARGS <#1,
		     #2 & [SYNSEM.LOCAL.CAT [ SPR <>,
					      SUBJ <#1>]]> ,
	       HD-DTR #2].

				     

; (8)
hd-spr-ph := hd-ph & 
	     [SYNSEM.LOCAL.CAT.SPR <>,
	      HD-DTR #2,
	      ARGS <#1, 
		    #2 & [SYNSEM.LOCAL.CAT.SPR <#1>] >].


; (10)
; simplification: we allow only a single item to be
; in the SLASH
hd-fill-ph := hd-ph &
	      [ SYNSEM.SLASH *null*,
		HD-DTR #h,
		ARGS < [SYNSEM.LOCAL #1],
		       #h & phrase & [SYNSEM [LOCAL.CAT.HEAD v,
					      SLASH  < #1 >]] >].


hd-only-ph := hd-ph &
	      [HD-DTR #h,
	       ARGS < #h >].

				     
	      
; (9) 
sai-ph := hd-ph &
	  [SYNSEM.LOCAL.CAT.SUBJ <>,
	   HD-DTR #h & word & [SYNSEM.LOCAL.CAT [HEAD [INV +,
						       AUX +],
						 SUBJ <#0>,
						 COMPS #A]],
	   ARGS [FIRST #h,
		 REST [FIRST #0,
		       REST #A]]].


; (11)
;hd-frag-ph := hd-only-ph &
;	      [SYNSEM.LOCAL.CAT [HEAD v & [VFORM fin],
;				 SUBJ <>,
;				 SPR <>],
;	       CONTEXT.SAL-UTT < [CAT #1,
;				  CONT.INDEX #2] >,
;	       HD-DTR #h & [SYNSEM.LOCAL [CAT #1 & [HEAD nominal],
;					  CONT.INDEX #2]],
;	       ARGS < #h >].
			    
					  
				 
				      



; CLAUSALITY
; (12), (13)
; TODO: typed list
clause := phrase &
	  [SYNSEM.LOCAL [CAT.SUBJ *list*,
			 CONT message]].


non-clause := phrase.

; (23)
rel-cl := clause & 
	  [SYNSEM.LOCAL [CAT.HEAD [IC -,
				   INV -,
				   MOD noun],
			 CONT fact]].


; (14)
core-cl := clause &
	   [SYNSEM.LOCAL.CAT.HEAD verbal & [VFORM clausal,
					    MOD none]].


impl-cl := core-cl.

; (15)
decl-cl := core-cl &
	   [SYNSEM.LOCAL.CONT austinian & [SOA soa /L #1],
	    HD-DTR [SYNSEM.LOCAL.CONT soa /L #1]].


; (16),(17) Iterrogative Retrieval Constraint (IRC)
; PARAMS set union is implemented as a different list append
; see ITFSG section 4.3 (p95)
inter-cl := core-cl &
	    [SYNSEM.LOCAL [CONT question & [PARAMS [LIST #middle,
						    LAST #last]],
			   STORE [LIST #first,
				  LAST #middle]],
	     HD-DTR [SYNSEM.LOCAL.STORE [LIST #first,
					 LAST #last]]].



;(21)
excl-cl := core-cl &
	   [SYNSEM.LOCAL.CONT fact].

;(22)
imp-cl := core-cl &
	  [SYNSEM.LOCAL.CONT outcome].



; (18) Filler Inclusion Constraint (FIC): this is a watered down
; version of the constraint, it forces there to only be a single PARAM
; rules
; (19) Propositional Head Constraint (PHC)
wh-int-cl := inter-cl & hd-fill-ph &
	     [SYNSEM.LOCAL.CONT.PARAMS <! #1 !>,
	      HD-DTR #h,
	      ARGS <[SYNSEM.WH <! #1 !>], #h>] &

	     [SYNSEM.LOCAL.CONT.PROP #2,
	      HD-DTR [SYNSEM.LOCAL.CONT #2]].


; (20)
; TODO: watered down STORE condition, we just force it to be empty
; in the parent for now
is-int-cl := inter-cl & hd-subj-ph &
	     [SYNSEM.LOCAL [CAT.HEAD [IC +,
				     VFORM fin],
			    STORE <! !>],
	      HD-DTR [SYNSEM.LOCAL.STORE *ne-dlist*]]. 

; -------------
; MAXIMAL TYPES 
; (24)
inv-decl-cl := decl-cl & sai-ph &
	       [SYNSEM.SLASH *ne-list*,
		HD-DTR #h & [SYNSEM.LOCAL.CAT.HEAD.IC +],
		ARGS [FIRST #h,
		      REST *ne-list*]].



cp-cl := core-cl & hd-comp-ph &
	 [SYNSEM.SLASH <>,
	  HD-DTR #h,
	  ARGS <#h & [SYNSEM [LOCAL.CAT.HEAD c]], ...>].

ns-impl-cl := impl-cl & hd-only-ph.
ger-cl := clause & hd-comp-ph.

; (26)

decl-ns-cl := decl-cl & hd-only-ph &
	      [SYNSEM.LOCAL.CAT [HEAD v & [INV -],
				 SUBJ < phrase >]].
	       




; GHFP should take care of coindexing CAT values...not sure why it isn't!
; (29) (a) Inversion Constraint INVC
; (29) (b) Optional Pro Condition OPC -- this is implemented in the rule
ns-wh-int-cl := wh-int-cl &
		[SYNSEM.LOCAL.CAT #3,
		 HD-DTR [SYNSEM.LOCAL.CAT #3 & [HEAD [IC #1,
						      INV #1]]]].

; (30)
su-wh-int-cl := wh-int-cl &
		[SYNSEM.LOCAL.CAT.SUBJ <>,
		 HD-DTR #h,
		 ARGS <[SYNSEM.LOCAL #4], #h & [SYNSEM.LOCAL.CAT.SUBJ <[SYNSEM gap-ss & [LOCAL #4]]>]>].


top-cl := core-cl & hd-fill-ph &
	  [HD-DTR #h,
	   ARGS <[SYNSEM.WH <! !>], #h & [SYNSEM.LOCAL.CAT [HEAD [VFORM fin,
								  IC +],
							    SUBJ < >]]>].

factive-cl := core-cl & hd-only-ph.

;(25)
decl-hd-su-cl := decl-cl & hd-subj-ph & [ARGS <[SYNSEM.WH <! !>], 
					       phrase & [SYNSEM.LOCAL.CAT [HEAD [VFORM fin,
										 INV -]]]>].


rep-int-cl := is-int-cl.
dir-is-int-cl := is-int-cl.


; (41)
;note we need multiple actual rules to get this done in rules file	     
; note we explicity put in the SLASH amalgamation constraint (3) here
fin-vp := non-clause & hd-comp-ph &
	  [SYNSEM.SLASH #S,
	   HD-DTR #h & [SYNSEM [LOCAL.CAT [ HEAD [VFORM fin,
						  AUX #1,
						  POL #1],
					    COMPS #C],
				SLASH #S]],
			
	   ARGS [FIRST #h,
		 REST #C]].




nf-hc-ph := non-clause & hd-comp-ph &
	    [SYNSEM.SLASH #S,
	     HD-DTR #h,
	     ARGS [FIRST #h & [SYNSEM [LOCAL.CAT [HEAD.VFORM nonfin,
						  COMPS #C],
				       SLASH #S]],
		   
		   REST #C]].


;bare-nom-ph := non-clause & hd-only-ph.
;bare-adj-ph := non-clause & hd-only-ph.
;nom-int-ph := non-clause & hd-only-ph.
;cq-np := non-clause & hd-only-ph.

; (27)
; TODO: not implemented
;decl-frag-cl := decl-cl & hd-frag-ph &
;		[SYNSEM.LOCAL [ CAT.HEAD [IC +],
;				CONT proposition & [SIT #s,
;						    SOA [QUANTS 
;slu-int-cl := inter-cl & hd-frag-ph.

; (28)
pol-int-cl := inter-cl & sai-ph &
	      [SYNSEM [LOCAL.CONT [PARAMS *null-dlist*,
				   PROP proposition & [SOA #1]],
		       SLASH #S],
	       HD-DTR #h & [SYNSEM [LOCAL [CAT.HEAD.IC +,
					   CONT #1],
				    SLASH #S]],
	       ARGS [FIRST #h,
		     REST *list*]].





; SEMANTIC types
sem-obj := feature-structure.
message := sem-obj.
austinian := message &
	     [ SIT situation,
	       SOA soa].

proposition := austinian &
	       [ SOA r-soa].

outcome := austinian &
	   [ SOA i-soa].

prop-constr := message &
	       [PROP proposition].

fact := prop-constr.



question := prop-constr &
	    [ PARAMS *dlist* ].

soa := sem-obj &
       [QUANTS *dlist*,
	NUCL rel].

r-soa := soa.
i-soa := soa &
	 [T-PARAM param].

pos-soa := soa.
qf-pos-soa := pos-soa & 
	      [QUANTS <! pquant-rel !>].

qf-fr-pos-soa := pos-soa & 
		 [QUANTS <! !>].
neg-soa := soa & 
	   [QUANTS <! nquant-rel !>].

scope-obj := sem-obj &
	     [ INDEX index,
	       RESTR *dlist* ].
rel := sem-obj &
       [INDICES *list*].


quant-rel := scope-obj & rel.
nquant-rel := quant-rel.
pquant-rel := quant-rel.
param := scope-obj.
index := sem-obj.


	     

;;;;;
;made up stuff
situation := sem-obj.
reflexive := scope-obj.
ref := index.

mod := feature-structure.
none := mod.
noun := mod.


;; predicate types used for BCKGRND
predicate := feature-structure & [PREDICATE string,
				  PARGS *list*].
    

; borrowed from "textbook" grammar
agr-cat := feature-structure &
	   [ PER per,
	     NUM num].

3sing := agr-cat &
 [ PER 3rd,
   NUM sing ].

non-3sing :< agr-cat.
2orplural := non-3sing. 

1sing := non-3sing &
	 [ PER 1st,
	   NUM sing ].

per :< feature-structure.
1or3 :< per.
1st := 1or3.
3rd :< 1or3.
2nd :< per.

num :< feature-structure.
sing :< num. 
plur :< num.
singandplur :< num. 




;;;
;;; standard types
;;;

string := *top*.

*list* := *top*.

*ne-list* := *list* &
 [ FIRST *top*,
   REST *list* ].

*null* := *list*.

*dlist* := *top* &
[ LIST *list*,
  LAST *list* ].

*null-dlist* := *dlist* &
[ LIST #last,
  LAST #last ].

*ne-dlist* := *dlist* &
[LIST *ne-list* ].