;;; -*- Mode: tdl; Coding: utf-8; -*-
;;;
;;;  Copyright (c) 1994-2018
;;;    Dan Flickinger, Rob Malouf, Emily M. Bender
;;;    see LICENSE for conditions
;;;
;;;  auxverbs.tdl
;;;
;;;  The auxiliary verb system for English
;;;
;;;  Created: Rob Malouf, 17-Nov-1994
;;;
;;;  $Id$

;; DPF 2020-05-07 - Moved VFORM fin to will_aux_word, so we can use this
;; type for non-finite (robust) verb types.  Same for TAM indic_tam.
;; DPF 2021-06-09 - Push supertype basic_two_arg down to subtypes, to enable
;; robust copula taking base VP with or without gap, to get as robust both
;; "they were arrive" and "they were devour"
;; DPF 2021-06-24 - Removed recently added COMPS..SLASH *arglist* since it
;; blocks "tomorrow we will arise".  
;;
will_aux_synsem := basic_aux_verb & ssr_subst &
  [ LOCAL [ CAT [ HEAD [ AUX +,
			 PRD -,
			 MINORS [ MIN #min,
				  ALTMIN #altmin ] ],
		  POSTHD +,
		  VAL [ SUBJ < synsem & 
			       [ LOCAL [ CAT nomp_cat_nom_min,
					 CONT.HOOK.LTOP #ltop,
					 CONJ cnil ],
				 OPT - ] >,
			COMPS < synsem &
				[ LOCAL [ CAT vp_cat &
					      [ HEAD verb &
						     [ VFORM fin_or_bse,
						       PRD -,
						       MINORS.ALTMIN #altmin ]],
					  CONT.HOOK.LTOP #ltop,
					  CONJ cnil ],
				  OPT - ] > ] ] ],
    LKEYS.KEYREL [ LBL #ltop,
		   PRED #min ] ].

will_aux_word := aux_verb_word_super &
  [ SYNSEM.LOCAL.CAT.HEAD [ VFORM fin,
                            TAM indic_tam ] ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
basic_will_aux_pos_synsem := will_aux_synsem & basic_two_arg &
  [ LOCAL [ CAT.VAL.COMPS < canonical_or_unexpressed &
			    [ LOCAL.CONT.HOOK [ LTOP #hand,
						INDEX #event ] ] >,
	    CONT [ HOOK [ LTOP #hand,
			  INDEX #event ],
		   RELS <! !>,
 		   HCONS <! !>,
		   ICONS <! !> ] ],
    LKEYS.KEYREL.LBL #hand ].

will_aux_pos_synsem := basic_will_aux_pos_synsem &
  [ LOCAL [ CAT [ HEAD.TAM.TENSE #tense,
		  VAL.COMPS.FIRST.LOCAL.CAT vp_bse_unspec_cat ],
	    CONT.HOOK.INDEX.E.TENSE #tense ] ].

will_aux_pos_lex_e := will_aux_word &
  [ SYNSEM will_aux_pos_synsem ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
will_aux_inv_synsem := basic_two_arg & basic_verb_synsem & 
  [ LOCAL [ CAT [ HEAD [ AUX -,
			 VFORM fin,
			 TAM #tam,
			 MINORS.MIN v_event_rel ],
		  VAL [ SUBJ < canonical_synsem &
			       [ --MIN independent_rel,
				 LOCAL [ CAT basic_prd_cat &
					     [ HEAD v_or_a_or_p &
						    [ MOD < anti_synsem &
							  [ --SIND #sind ] >,
						      AUX - ],
					       VAL.SUBJ *olist* ],
					 CONT.HOOK 
					     [ INDEX event & #event,
					       XARG #sind & individual_min ] ],
				 OPT - ] >,
			SPR < anti_synsem_min >,
			COMPS < canonical_or_unexpressed &
				[ LOCAL [ CAT vp_bse_unspec_cat &
					      [ VAL.SUBJ 
						< [ LOCAL.CAT basic_prd_cat &
							      [ HEAD.AUX - ]]>],
					  CONJ cnil,
					  CONT.HOOK [ LTOP #hand,
						      XARG #sind ] ],
				  OPT -,
				  --SIND #xarg ] > ] ],
	    CONT [ HOOK [ LTOP #hand,
			  INDEX #event & [ E #tam ],
			  XARG #xarg ],
		   RELS <! !>,
		   HCONS <! !>,
		   ICONS <! !> ] ] ].

; inverted `will': "also included will be cats"

v_vp_will-inv_le := aux_verb_word_super & 
"""
Only aux `will', inverted
<ex>Also included will be C.
"""
  [ INFLECTD +,
    SYNSEM will_aux_inv_synsem ].

will_aux_pos_norm_synsem := will_aux_pos_synsem &
  [ LOCAL.CAT [ HEAD.TAM [ TENSE future,
			   MOOD indicative ],
		VAL.COMPS < [ LOCAL.CAT vp_bse_unspec_cat &
					[ HEAD.TAM.MOOD indicative ] ] > ] ].

v_vp_will-p_le := will_aux_pos_lex_e &
"""
Cmps VP(bse), aux, pos           
<ex>B will sing.
"""
 [ INFLECTD +,
   SYNSEM will_aux_pos_norm_synsem ].

v_vp_will-p-cx_le := will_aux_pos_lex_e & contracted_aux_word &
"""
Cmps VP(bse), aux, pos contract  
<ex>B'll sing.
"""
  [ SYNSEM will_aux_pos_norm_synsem ].

basic_will_aux_neg_synsem := will_aux_synsem &
  [ LOCAL [ CAT [ HEAD.TAM [ MOOD indicative ],
		  VAL.COMPS.FIRST.LOCAL [ CAT.HEAD.TAM.MOOD indicative,
					  CONT.HOOK.LTOP #chand ] ],
	    CONT [ HOOK [ LTOP #ltop,
			  INDEX #nevent ],
		   RELS <! #alt2keyrel & arg01_relation &
			 [ LBL #ltop,
			   PRED neg_rel,
			   ARG0 #nevent & non_conj_event,
			   ARG1 #arghand ] !>,
		   HCONS <! qeq & [ HARG #arghand,
				    LARG #chand ] !>,
		   ICONS <! !> ] ],
    LKEYS.ALT2KEYREL #alt2keyrel ].

will_aux_neg_synsem := basic_will_aux_neg_synsem & basic_two_arg &
  [ LOCAL [ CAT [ HEAD.TAM.TENSE #tense & future,
		  VAL.COMPS.FIRST.LOCAL.CAT vp_bse_unspec_cat &
				 [ HEAD.TAM.TENSE #tense ] ],
	    CONT.HOOK.INDEX.E.TENSE #tense ] ].

va_will_neg_lexent := will_aux_word & 
  [ INFLECTD +,
    SYNSEM will_aux_neg_synsem ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_will-n_le := va_will_neg_lexent &
"""
Cmps VP(bse), aux, neg contract  
<ex>B won't sing.
"""
  [ SYNSEM.LOCAL.CAT.VAL.COMPS.FIRST canonical_or_unexpressed ].

v_vp_will-n-niv_le := va_will_neg_lexent & aux_not_contr
"""
Cmps VP(bse), aux, neg c, no inv, no overt complement
<ex>B'll not.
"""
.


;;; Modal verbs


v_vp_mdl-p_lexent := modal_pos_indic_lexent &
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE present ].

v_vp_mdl-p_le := v_vp_mdl-p_lexent
"""
Cmps VP(bse), modal, pos         
<ex>B can sing.
"""
.
v_vp_must-p_le := modal_pos_indic_lexent &
"""
Cmps VP(bse), must, pos         
<ex>B must sing.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE present,
    ALTS.ADVADD - ].

v_vp_mdl-p-cx_le := modal_pos_indic_lexent & contracted_aux_word
"""
Cmps VP(bse), aux, pos contract  
<ex>B'd sing.
"""
.

; could
v_vp_mdl-p-pst_le := modal_pos_lex_ent &
"""
Cmps VP(bse), modal, pos, past   
<ex>B could sing yesterday.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE past,
    ALTS.CSAI - ].


; would - unsp for MOOD
;; DPF 2017-09-27 - Also underspecify for tense.
;;
v_vp_mdl-p-unsp_le := modal_pos_lex_ent &
"""
Cmps VP(bse), modal, pos,unsp md 
<ex>B would sing tomorrow.
"""
  [ INFLECTD +,
    ALTS.CSAI - ].

; 'd rather
v_vp_mdl-p-rather_le := basic_modal_pos_lex_ent &
"""
Cmps VP(bse), modal, pos, rather, non-inv
<ex>We'd rather not.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CONT.RELS <! [ LBL #chand,
				ARG0 #arg0 ],
			      [ LBL #chand,
				PRED "_rather_a_1_rel",
				ARG1 #arg0 ] !>,
    ALTS.CSAI - ].

v_vp_mdl-p-niv_lexent := modal_pos_indic_lexent &
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD [ TAM.TENSE present,
                            INV - ] ].

v_vp_mdl-p-niv_le := v_vp_mdl-p-niv_lexent
"""
Cmps VP(bse), modal, pos, no inv 
<ex>B better go.
"""
.
v_vp_mdl-p-sv_le := modal_pos_lex_ent &
"""
Cmps VP(bse), modal, pos, sbjctv 
<ex>B might sing.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE present ].

v_vp_mdl-p-inv_le := modal_pos_indic_lexent &
"""
Cmps VP(bse), inverted
<ex>Need B sing?
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD [ TAM.TENSE present,
			    INV + ],
    ALTS.SAI + ].

v_vp_oght-p_le := pos_ought_verb_word & add_cont &
"""
Cmps VP(inf), modal, pos         
<ex>B ought to sing.
"""
  [ SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE present ].

v_vp_oght-ellip_le := ought_ellip_verb_word & add_cont &
"""
Unexpressed comp VP(inf), modal, pos         
<ex>B ought (not).
"""
  [ SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE present ].

v_vp_oght-p-pst_le := past_ought_verb_word & add_cont &
"""
Cmps VP(inf), modal, pos, past   
<ex>B used to sing.
"""
  [ INFLECTD +,
    ALTS [ SAI -, CSAI - ],
    SYNSEM.LOCAL.CAT.HEAD.TAM.TENSE past ].

v_vp_qsmd_le := quasimodal_word &
"""
Cmps VP(inf), quasi-modal        
<ex>B is going to sing.
"""
  [ SYNSEM.LOCAL.CAT.HEAD [ VFORM prp, 
                            PRD + ] ].

v_vp_qsmd-psp_le := quasimodal_psp_word
"""
Cmps VP(inf), quasi-modal, psp   
<ex>B has got to sing.
"""
.

v_vp_qsmd-psp-bse_le := quasimodal_psp_bse_word
"""
Cmps VP(bse), quasi-modal, psp   
<ex>B has gotta sing.
"""
.

;; Block from nom-gerund rule
;;
v_vp_qsmd-bse_le := quasimodal_bse_word &
"""
Cmps VP(bse), quasi-modal        
<ex>B is gonna sing.
"""
  [ SYNSEM.LOCAL.CAT.HEAD [ VFORM prp, 
                            PRD + ],
    ALTS.NGER - ].

; 'didn't he used to sing?'
v_vp_nfin-mod_lexent := nonfin_modal_word.

v_vp_nfin-mod_le := v_vp_nfin-mod_lexent
"""
Cmps VP(inf), s-s-rais, nonfin   
<ex>Didn't C used to sing?
"""
.

generic_modal_neg_basic_synsem := aux_verb_ssr &
  [ LOCAL [ CONT [ RELS <! #alt2keyrel & adv_relation &
			   [ PRED neg_rel,
			     ARG0 non_conj_event,
			     ARG1 #narghand ], 
			   #keyrel !>,
		   HCONS <! qeq &
			  [ HARG #arghand ],
			  qeq &
			  [ HARG #narghand ] !> ] ],
    LKEYS [ KEYREL #keyrel &
		   [ PRED modal_rel,
		     ARG0 non_conj_event,
		     ARG1 #arghand ],
	    ALT2KEYREL #alt2keyrel ] ].

generic_modal_neg_basic := aux_verb_word_super &
  [ INFLECTD +,
    SYNSEM generic_modal_neg_basic_synsem,
    ALTS.CSAI - ].

generic_modal_neg_super_synsem := generic_modal_neg_basic_synsem &
  [ LOCAL [ CAT.VAL.KCMP.LOCAL.CONT.HOOK.LTOP #chand,
	    CONT [ HOOK.LTOP #ltop,
		   RELS <! [ LBL #ltop ], relation !>,
		   HCONS <! [ LARG #chand ],
			    [ LARG #khand ] !> ] ],
    LKEYS.KEYREL.LBL #khand ].

generic_modal_neg_super := generic_modal_neg_basic &
  [ SYNSEM generic_modal_neg_super_synsem ].

must_modal_neg_synsem := generic_modal_neg_basic_synsem &
  [ LOCAL [ CAT.VAL.KCMP.LOCAL.CONT.HOOK.LTOP #chand,
	    CONT [ HOOK.LTOP #khand,
		   RELS <! [ LBL #neghand ], relation !>,
		   HCONS <! [ LARG #neghand ],
			    [ LARG #chand ] !> ] ],
    LKEYS.KEYREL.LBL #khand ].

must_modal_neg := generic_modal_neg_basic &
  [ SYNSEM must_modal_neg_synsem ].

generic_modal_neg := generic_modal_neg_super & aux_verb_word &
  [ SYNSEM.LOCAL.CAT.POSTHD + ].

modal_neg_synsem := modal_verb_synsem & generic_modal_neg_super_synsem.

va_modal_neg_lexent := modal_verb_word & generic_modal_neg &
  [ SYNSEM modal_neg_synsem &
	   [ LKEYS.KEYREL.PRED modal_rel ] ].

must_neg_synsem := generic_modal_verb_super_synsem & must_modal_neg_synsem &
		   bse_aux_verb_ssr &
  [ LOCAL [ CAT [ HEAD [ PRD -,
			 VFORM fin ],
		  POSTHD +,
		  VAL [ SUBJ < synsem & [ LOCAL [ CAT nomp_cat_nom_min,
						  CONJ cnil ],
					  --SIND basic_non_event,
					  OPT - ] >,
			COMPS.FIRST [ LOCAL.CAT vp_bse_cat,
				      --SIND.SF basic-prop ] ] ],
	    CONT psoa ],
    LKEYS.KEYREL.PRED modal_rel ].

va_must_neg_lexent := generic_modal_verb_word_super & must_modal_neg &
		      bse_aux_verb_word &
  [ SYNSEM must_neg_synsem ].

		      
;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_mdl-n_le := va_modal_neg_lexent &
"""
Cmps VP(bse), modal, neg-cntrct  
<ex>B can't sing.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM.TENSE present,
		       VAL.COMPS.FIRST canonical_or_unexpressed ] ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_must-n_le := va_must_neg_lexent &
"""
Cmps VP(bse), modal must, neg-cntrct (idiosyncratic scope)
<ex>B mustn't sing.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM.TENSE present,
		       VAL.COMPS.FIRST canonical_or_unexpressed ] ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
; couldn't
v_vp_mdl-n-pst_le := va_modal_neg_lexent &
"""
Cmps VP(bse), modal, neg-c, past 
<ex>B couldn't sing.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM.TENSE past,
		       VAL.COMPS.FIRST canonical_or_unexpressed ] ].

v_vp_mdl-n-niv_le := va_modal_neg_lexent &
"""
Cmps VP(bse), modal,neg-c,no inv, no overt comp
<ex>B hadn't better leave.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD [ TAM.TENSE present,
			      INV - ],
		       VAL.COMPS.FIRST canonical_or_unexpressed ] ].


modal_neg_verb_synsem := modal_verb_synsem & generic_modal_neg_super_synsem.

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_mdl-n-sv_le := modal_verb_word & generic_modal_neg & 
"""
Cmps VP(bse), modal, neg-c       
<ex>B shouldn't sing.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD [ TAM.TENSE present ],
		       VAL.COMPS.FIRST canonical_or_unexpressed ] ].

ought_verb_neg_synsem := ought_verb_synsem & generic_modal_neg_super_synsem.

v_vp_oght-n_le := ought_verb_word & generic_modal_neg_super &
"""
Cmps VP(inf), modal, neg-c       
<ex>B oughtn't to sing.
"""
  [ SYNSEM.LOCAL.CAT.HEAD [ TAM.TENSE present ] ].

; *** Auxiliary DO ***

; For tag questions we need the MIN of auxiliary _do_ to match all main verbs.
; The supertype for this is v_event_rel.  Originally, it had been no_rel, to 
; block _do_'s being a complement of other auxiliaries.  On the hypothesis
; that auxiliary _do_ in fact lacks a non-finite form all together, the
; do_aux_word type is constrained to VFORM fin.
;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
; 2020-12-10
basic_do_aux_synsem := ssr_two_arg_verb &
  [ LOCAL [ CAT [ HEAD [ AUX +,
			 TAM [ TENSE #tense,
			       ASPECT #aspect,
			       MOOD indicative ],
			 MINORS.MIN nonaux_event_rel ],
		  VAL [ SUBJ < synsem & 
			       [ OPT -,
				 LOCAL [ CAT nomp_cat_nom_min &
					     [ HEAD #subjhd &
						    [ MINORS #minors ] ],
					 CONJ cnil ] ] >,
			COMPS < canonical_or_unexpressed &
				[ LOCAL [ CAT vp_cat &
					      [ VAL.SUBJ.FIRST.LOCAL.CAT.HEAD
						 [ MINORS #minors ],
						RSUBJHD #subjhd ],
					  CONT.HOOK [ LTOP #cltop,
						      INDEX #index &
						       [ E [ TENSE #tense,
							     ASPECT #aspect ]]],
					  CONJ cnil ],
				  --SIND #index,
				  OPT - ] > ],
		  POSTHD + ],
	    CONT psoa & [ HOOK.INDEX [ E.MOOD indicative ] ] ],
    LKEYS.KEYREL [ LBL #cltop,
		   PRED mod_role_rel ] ].

do_aux_synsem := basic_do_aux_synsem &
  [ LOCAL.CAT.VAL.COMPS.FIRST [ --MIN nonaux_event_rel,
				LOCAL.CAT vp_bse_unspec_cat &
				          [ HEAD.AUX - ] ] ].

do_aux_word := noncqr-hm &
  [ INFLECTD +,
    SYNSEM basic_do_aux_synsem,
    ALTS.CSAI - ].

; Removed raise-cont from parents, to allow ARG0 to not be identified with the
; comp-dtr's ARG0   - is in conflict with collapsing of base and fin-non3rdsg 
; forms, given that we encode VIT attributes in the event feature structure.
; Sample problem: "Kim does sleep"

; DPF 6-Feb-02 - Changed MOOD indicative to indicative* in order to support
; coordination of e.g. yes-no questions and modal_subj declaratives.  Same in
; type do_aux_neg_pres.
; DPF 13-Mar-02 - But this allowed "want" version of "like" to be complement.
; So instead make do_aux_word stamp indicative* for its own MOOD, and not
; copy it up from complement dtr.  Then require complement dtr to be simply
; MOOD indicative.  And by the way broke link from "do" to bse_aux_verb_word
; which insists on making the aux verb's TAM identical to its INDEX, which we
; can't have for "do".

; 2020-12-10
basic_do_fin_synsem := basic_do_aux_synsem &
  [ LOCAL local &
	  [ CAT [ HEAD [ VFORM fin,
			 PRD - ],
		  VAL [ SUBJ < [ OPT -,
				 LOCAL.CONT.HOOK.LTOP #hand ] >,
			COMPS.FIRST.LOCAL.CONT.HOOK [ LTOP #hand,
						      INDEX #event ] ] ],
	    CONT [ HOOK [ LTOP #hand,
			  INDEX #event ],
		   RELS <! !>,
		   HCONS <! !>,
		   ICONS <! !> ] ] ].

do_fin_synsem := basic_do_fin_synsem & do_aux_synsem.
do_fin := do_aux_word & raise_cont & 
  [ SYNSEM do_fin_synsem ].

; 2020-12-10
basic_do_aux_neg_synsem := basic_do_aux_synsem &
  [ LOCAL [ CAT [ HEAD [ PRD -,
			 VFORM fin ],
		  VAL [ SUBJ.FIRST.LOCAL.CONT.HOOK.LTOP #chand,
			COMPS.FIRST.LOCAL.CONT.HOOK.LTOP #chand ] ],
	    CONT [ HOOK [ LTOP #ltop,
			  INDEX #nevent ],
		   RELS <! #alt2keyrel & arg01_relation &
			 [ LBL #ltop,
			   PRED neg_rel,
			   ARG0 #nevent & non_conj_event,
			   ARG1 #arghand ] !>,
		   HCONS <! qeq &
			  [ HARG #arghand,
			    LARG #chand ] !>,
		   ICONS <! !> ] ],
    LKEYS.ALT2KEYREL #alt2keyrel ].

do_aux_neg_synsem := basic_do_aux_neg_synsem & do_aux_synsem.

do_aux_neg_word := do_aux_word &
  [ SYNSEM do_aux_neg_synsem ].

do_aux_neg_aux_synsem := basic_do_aux_neg_synsem &
  [ LOCAL.CAT.VAL.COMPS.FIRST.LOCAL.CAT vp_bse_unspec_cat ].

;; Allow AUX + complements, to get "why don't you be in charge?"
do_aux_neg_aux_word := do_aux_word &
  [ SYNSEM basic_do_aux_neg_synsem ].

;; DPF 2018-12-04 - Changed identity of concord and agreement, moving
;; SUBJ..--SIND.PNG to SUBJ..AGR.PNG, to allow *the majority of cats sleep*.
;;
basic_do_pres_synsem := basic_do_fin_synsem &
  [ LOCAL [ CAT [ HEAD.TAM indic_tam &
			   [ TENSE present,
			     ASPECT no_aspect ],
		  VAL.SUBJ < [ LOCAL.AGR.PNG #png ] > ],
	    AGR.PNG #png ] ].

do_pres_synsem := basic_do_pres_synsem & do_fin_synsem.

do_pres := do_fin &
  [ SYNSEM do_pres_synsem ].

;; DPF 2018-12-04 - Moved SUBJ..PN -3s to AGR since sem.agreement was blocking 
;; *the majority of cats sleep*, where AGR does the job of ensuring agreement.
;;
v_vp_does_le := do_pres & 
"""
Cmps VP(bse), do, pres 3sg       
<ex>B does not sing.
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

v_vp_do-f_le := do_pres &
"""
Cmps VP(bse), do, pres non3sg    
<ex>We do not sing.
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -3s ] ].

v_vp_did_le := do_fin &
"""
Cmps VP(bse), do, past           
<ex>B did not sing.
"""
  [ SYNSEM.LOCAL.CAT.HEAD [ TAM past_or_subj_tam ] ].

do_aux_neg_pres := do_aux_neg_word &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM indic_tam &
                              [ TENSE present,
				ASPECT no_aspect ] ].

;; Allow AUX + complements, to get "why don't you be in charge?"
do_aux_neg_aux_pres := do_aux_neg_aux_word &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM indic_tam &
                              [ TENSE present,
				ASPECT no_aspect ] ].

v_vp_did-n_le := do_aux_neg_word & 
"""
Cmps VP(bse), do, neg-c, past    
<ex>B didn't sing.
"""
  [ SYNSEM.LOCAL.CAT.HEAD.TAM past_or_subj_tam ].

; ERB (31-03-97) The agreement on do, but not have and be, was previously
; taken care of in lexicon.tdl.  I am making these types to move that
; information here for symmetry.  The rest of the do paradigm seems
; to be generated by lexical rules, so these two are the only types.
;; DPF 2024-04-16 - Change parent from do_aux_neg_pres to do_aux_neg_aux_pres
;; so we can also get "why doesn't he be more tolerant?"
v_vp_does-n_le := do_aux_neg_aux_pres & 
"""
Cmps VP(bse), do, neg-c, pres3sg 
<ex>B doesn't sing.
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

;; DPF 2024-04-12 - Relax the usual constraint on auxiliary "do" to block
;; aux-VP complements (e.g. "*they do be happy"), in order to get "why don't
;; you be in charge?".
;;
v_vp_do-f-n_le := do_aux_neg_aux_pres &
"""
Cmps VP(bse), do, neg-c,pr n3sg  
<ex>We don't sing.
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -3s ] ].

; *** Perfect HAVE ***

; 2020-12-10
;; DPF 2024-04-12 - Relaxed parent from aux_verb_ssr to basic_aux_verb_ssr
;; in order to get locative inversion with perfect, as in
;; "in the corner had been standing a broom"
basic_have_aux_verb_synsem := basic_aux_verb_ssr &
  [ LOCAL [ CONT.HOOK [ LTOP #lbl ] ],
    LKEYS.KEYREL [ PRED have_aux_rel,
		   LBL #lbl ] ].

have_aux_verb_synsem := basic_have_aux_verb_synsem & basic_psp_aux_verb_ssr &
  [ LOCAL.CAT.HEAD.TAM.ASPECT.PRF + ].

have_aux_word := basic_aux_verb_word & 
  [ SYNSEM have_aux_verb_synsem ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
; 2020-12-10
have_aux_pos_synsem := have_aux_verb_synsem &
  [ LOCAL [ CAT.VAL.COMPS < canonical_or_unexpressed &
			    [ LOCAL.CONT.HOOK [ LTOP #hand,
						INDEX #event ] ] >,
	    CONT [ HOOK [ LTOP #hand,
			  INDEX #event ],
		   RELS <! !>,
		   HCONS <! !>,
		   ICONS <! !> ] ] ].

have_aux_pos_lex_entry := have_aux_word &
  [ SYNSEM have_aux_pos_synsem ].

;; DPF 2022-05-16 - Constrain COMPS.FIRST to non_canonical to allow
;; contracted negated auxiliaries to appear either with no complement (elided)
;; or with gapped complement, to get both "We'll not." and "A genius, he's not."
;; while avoiding redundant analysis of "He's not a cat."
;;
aux_not_contr := sign &
  [ SYNSEM.LOCAL.CAT [ HEAD.INV -,
                       VAL.COMPS.FIRST non_canonical & [ OPT - ] ] ].
                   
; 2020-12-10
have_aux_neg_synsem := have_aux_verb_synsem &
  [ LOCAL [ CAT [ HEAD [ VFORM fin,
			 PRD - ],
		  POSTHD +,
		  VAL [ SUBJ < [ OPT - ] >,
			COMPS.FIRST.LOCAL.CONT.HOOK.LTOP #chand ] ],
	    CONT [ HOOK [ LTOP #ltop,
			  INDEX #nevent ],
		   RELS <! #alt2keyrel & arg01_relation &
			 [ LBL #ltop,
			   PRED neg_rel,
			   ARG0 #nevent & non_conj_event,
			   ARG1 #arghand ] !>,
		   HCONS <! qeq &
			  [ HARG #arghand,
			    LARG #chand ] !>,
		   ICONS <! !> ] ],
    LKEYS.ALT2KEYREL #alt2keyrel ].

have_aux_neg_lex_entry := have_aux_word &
  [ INFLECTD +,
    SYNSEM have_aux_neg_synsem,
    ALTS.CSAI - ].

have_fin_synsem := have_aux_verb_synsem &
  [ LOCAL local &
	  [ CAT [ HEAD [ VFORM fin,
			 PRD - ],
		  POSTHD +,
		  VAL.SUBJ < synsem & 
			     [ LOCAL [ CONJ cnil ],
			       OPT - ] > ],
	    CONT psoa ]].

have_fin := have_aux_word &
  [ SYNSEM have_fin_synsem ].

have_pres := have_fin &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM indic_tam &
                              [ TENSE present,
				ASPECT.PRF + ],
    ALTS.CSAI - ].

have_past := have_fin &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM [ TENSE past,
				ASPECT.PRF +,
				MOOD indicative ],
    ALTS.CSAI - ].

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
have_subj := have_fin &
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM subjnct_tam &
				[ ASPECT.PRF +,
				  MOOD subjunctive ],
		       VAL.COMPS.FIRST canonical_or_unexpressed ] ].

;; We make "having" be [PRD -] to block "Kim is having fallen" and (the
;; restrictive reading of) "The book having fallen is red".  We will also 
;; exclude possibly grammatical examples like "anyone having seen that movie"
;; but there are no attested instances of these in the full BNC.
;; DPF 29-oct-06 - Remove this PRD - constraint, since it also blocks
;; depictives as in "We left, having finished."  Instead, block "is having"
;; by adding NORM no_rel.  Maybe FIX?

v_vp_have-prp_le := have_aux_pos_lex_entry &
"""
Cmps VP(psp), have, prp          
<ex>Having sung, B left.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD [ VFORM prp,
                            TAM.ASPECT.PROGR +,
                            MINORS.NORM no_rel ] ].

va_have_bse_lexent := have_aux_pos_lex_entry &
  [ SYNSEM.LOCAL [ CAT [ HEAD [ PRD -,
                                VFORM bse_only,
                                TAM.ASPECT.PRF + ],
                         VAL.SUBJ < unexpressed >,
                         POSTHD + ],
		   CONT psoa ] ].

v_vp_have-bse_le := va_have_bse_lexent &
"""
Cmps VP(psp), have, bse          
<ex>B will have sung.
"""
  [ INFLECTD + ].
    
v_vp_have-bse-cx_le := va_have_bse_lexent & contracted_aux_word
"""
Cmps VP(psp), have, bse, contr   
<ex>We would've sung.
"""
.

has_aux_lex_ent := have_aux_pos_lex_entry & have_pres &
  [ SYNSEM.LOCAL.CAT.VAL.SUBJ < synsem & 
				[ LOCAL.AGR.PNG png & [ PN 3s ] ] > ].

v_vp_has_le := has_aux_lex_ent &
"""
Cmps VP(psp), have, 3sg          
<ex>B has sung.
"""
  [ INFLECTD + ].
    
v_vp_has-cx_le := has_aux_lex_ent & contracted_aux_word
"""
Cmps VP(psp), have, 3sg, contr   
<ex>B's sung.
"""
.

have_fin_aux_lex_ent := have_aux_pos_lex_entry & have_pres &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -3s ] ].

v_vp_have-f_le := have_fin_aux_lex_ent &
"""
Cmps VP(psp), have, n3sg         
<ex>We have sung.
"""
  [ INFLECTD + ].

v_vp_have-f-cx_le := have_fin_aux_lex_ent & contracted_aux_word
"""
Cmps VP(psp), have, n3sg, contr  
<ex>We've sung.
"""
.

have_pos_fin_synsem := have_aux_pos_synsem & have_fin_synsem.

had_aux_lex_ent := have_aux_pos_lex_entry & have_past &
  [ SYNSEM have_pos_fin_synsem ].

v_vp_had-sv_le := have_aux_pos_lex_entry & have_subj &
"""
Cmps VP(psp), have, subjtv       
<ex>If we had sung, B would've
"""
  [ INFLECTD +,
    SYNSEM have_pos_fin_synsem ].

v_vp_had_le := had_aux_lex_ent &
"""
Cmps VP(psp), have, past         
<ex>B had sung.
"""
  [ INFLECTD + ].

v_vp_had-cx_le := had_aux_lex_ent & contracted_aux_word
"""
Cmps VP(psp), have, past, contr  
<ex>B'd sung already.
"""
.

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_has-n_le := have_aux_neg_lex_entry & have_pres & 
"""
Cmps VP(psp), have, 3sg, neg-c   
<ex>B hasn't sung.
"""
  [ SYNSEM.LOCAL [ AGR.PNG png & [ PN 3s ],
		   CAT.VAL.COMPS.FIRST canonical_or_unexpressed ] ].

v_vp_has-n-niv_le := have_aux_neg_lex_entry & have_pres & aux_not_contr &
"""
Cmps VP(psp), have,3sg,ng-c,ninv, no overt comp
<ex>B's not.
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

have_aux_neg_fin_synsem := have_aux_neg_synsem & have_fin_synsem.

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_have-f-n_le := have_aux_neg_lex_entry & have_pres & 
"""
Cmps VP(psp), have, n3sg, neg-c  
<ex>We haven't sung.
"""
  [ SYNSEM have_aux_neg_fin_synsem &
	   [ LOCAL [ AGR.PNG png & [ PN -3s ],
		     CAT.VAL.COMPS.FIRST canonical_or_unexpressed ] ] ].


v_vp_have-n-niv_le := have_aux_neg_lex_entry & have_pres & 
		      aux_not_contr &
"""
Cmps VP(psp), have,n3sg,ngc,ninv, no overt comp
<ex>We've not.
"""
  [ SYNSEM have_aux_neg_fin_synsem &
	   [ LOCAL.AGR.PNG png & [ PN -3s ] ] ].


;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
v_vp_had-n_le := have_aux_neg_lex_entry & have_past &
"""
Cmps VP(psp), have, past, neg-c  
<ex>B hadn't sung.
"""
  [ SYNSEM have_aux_neg_fin_synsem &
	   [ LOCAL.CAT.VAL.COMPS.FIRST canonical_or_unexpressed ] ].

v_vp_had-n-niv_le := have_aux_neg_lex_entry & have_past & aux_not_contr &
"""
Cmps VP(psp), have,past,ngc,ninv, no overt complement
<ex>B'd not.
"""
  [ SYNSEM have_aux_neg_fin_synsem ].

v_vp_had-n-sv_le := have_aux_neg_lex_entry & have_subj &
"""
Cmps VP(psp), have, subjtv,neg-c 
<ex>If we hadn't sung, B'd've
"""
  [ SYNSEM have_aux_neg_fin_synsem ].

;;  British possessive `have'
;;
; 2020-12-10
have_poss_aux_verb_lex := noncqr-hm &
  [ INFLECTD +,
    SYNSEM aux_np_verb &
	   [ LOCAL [ CAT [ HEAD [ PRD -,
				  VFORM fin ],
			   VAL [ SUBJ < [ LOCAL [ CAT nomp_cat_min &
			                              [ HEAD.CASE nom ],
						  CONT.HOOK.LTOP #ltop,
						  CONJ cnil ],
					  OPT - ] >,
				 COMPS < synsem & 
					 [ OPT -,
					   LOCAL [ CAT.HEAD.--BARE -,
						   CONT.HOOK.LTOP #ltop ] ] >,
				 SPCMPS < > ] ] ],
	     LKEYS.KEYREL [ LBL #ltop,
			    PRED "_have_v_1_rel" ] ],
    DIALECT br ].


; 2020-12-10
have_poss_aux_pos := have_poss_aux_verb_lex &
  [ SYNSEM [ LOCAL [ CAT.HEAD.INV +,
		     CONT [ HOOK [ LTOP #ltop,
				   INDEX #event ],
			    RELS <! #keyrel & [ ARG0 #event ] !>,
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop ] ] ].

; 2020-12-10
have_poss_aux_neg := have_poss_aux_verb_lex &
  [ SYNSEM [ LOCAL.CONT [ HOOK [ LTOP #ltop,
				 INDEX #nevent ],
			  RELS <! #keyrel, #alt2keyrel !>,
			  HCONS <! qeq & [ HARG #arghand,
					   LARG #khand ] !>,
			  ICONS <! !> ],
             LKEYS [ KEYREL #keyrel & [ LBL #khand ],
                     ALT2KEYREL #alt2keyrel & arg01_relation &
                                [ LBL #ltop,
                                  PRED neg_rel,
				  ARG0 #nevent & non_conj_event,
                                  ARG1 #arghand ] ] ] ].

v_np_has-aux_le := have_poss_aux_pos &
"""
British possessive `has', inverted
<ex>Has she a reservation?
"""
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM indic_tam & [ TENSE present,
					      ASPECT [ PROGR -, PRF - ] ],
		       VAL.SUBJ < synsem & 
				  [ LOCAL.AGR.PNG png & [ PN 3s ] ] > ],
    ALTS.CSAI - ].

v_np_have-aux_lexent := have_poss_aux_pos &
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM indic_tam & [ TENSE present,
					      ASPECT [ PROGR -, PRF - ] ],
		       VAL.SUBJ < synsem & 
				  [ LOCAL.AGR.PNG png & [ PN -3s ] ] > ],
    ALTS.CSAI - ].

v_np_have-aux_le := v_np_have-aux_lexent
"""
British possessive `have', inverted
<ex>Have we a reservation?
"""
.
v_np_had-aux_le := have_poss_aux_pos &
"""
British possessive `had', inverted
<ex>Had she a reservation?
"""
  [ SYNSEM.LOCAL.CAT.HEAD.TAM [ TENSE past,
				ASPECT [ PROGR -, PRF - ],
				MOOD indicative ],
    ALTS.CSAI - ].

v_np_had-aux-sbj_le := have_poss_aux_pos &
"""
British possessive `had', inverted, subjunctive
<ex>Had she a reservation, she could be seated.
"""
  [ SYNSEM.LOCAL.CAT.HEAD [ TAM [ TENSE past,
				  ASPECT [ PROGR -, PRF - ],
				  MOOD subjunctive ],
			    INV + ] ].

v_np_has-aux-n_le := have_poss_aux_neg &
"""
British possessive contracted negative `hasn't'
<ex>He hasn't a clue.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM indic_tam & [ TENSE present,
					      ASPECT [ PROGR -, PRF - ] ],
		       VAL.SUBJ < synsem & 
				  [ LOCAL.AGR.PNG png & [ PN 3s ] ] > ] ].

v_np_have-aux-n_le := have_poss_aux_neg &
"""
British possessive contracted negative `haven't'
<ex>They haven't a clue.
"""
  [ SYNSEM.LOCAL.CAT [ HEAD.TAM indic_tam & [ TENSE present,
					      ASPECT [ PROGR -, PRF - ] ],
		       VAL.SUBJ < synsem & 
				  [ LOCAL.AGR.PNG png & [ PN -3s ] ] > ] ].

v_np_had-aux-n_le := have_poss_aux_neg &
"""
British possessive contracted negative `hadn't'
<ex>They hadn't a clue.
"""
  [ SYNSEM.LOCAL.CAT.HEAD.TAM [ TENSE past,
				ASPECT [ PROGR -, PRF - ],
				MOOD indicative ] ].

; *** should of ***

;; DPF 2016-12-02 - Generalized COMPS.FIRST from canonical_synsem to
;; canonical_or_unexpressed, so ellipsis rule can require unexpressed
;;
modal_of_synsem := psp_aux_verb_ssr &
  [ LOCAL [ CAT [ HEAD [ VFORM fin,
			 PRD -,
			 TAM indic_tam &
			       [ TENSE past,
				 ASPECT.PRF + ] ],
		  VAL [ SUBJ < synsem & 
			       [ LOCAL [ CAT nomp_cat_nom_min,
					 CONJ cnil ],
				 OPT - ] >,
			COMPS < canonical_or_unexpressed &
				[ LOCAL.CONT.HOOK.LTOP #chand ] > ] ],
	    CONT [ HOOK [ LTOP #hand,
			  INDEX #index ],
		   RELS <! #keyrel & [ LBL #hand,
				       ARG0 #index,
				       ARG1 #arg1 ] !>,
		   HCONS <! qeq & [ HARG #arg1,
				    LARG #chand ] !>,
		   ICONS <! !> ] ],
    LKEYS.KEYREL #keyrel ].

v_vp_mdl-of_le := psp_aux_verb_word & 
"""
Cmps VP(psp), modal+of          
<ex>B should of sung.
<ex>B coulda sung.
"""
  [ INFLECTD +,
    SYNSEM modal_of_synsem,
    ALTS.CSAI - ].

; *** Generic BE ***

;; DPF 2022-04-23 - SUBJ..CAT nomp_cat_min over-constrains HEAD to supnoun,
;; so pushed down to subtypes, to allow "in the corner was standing a coatrack"
be_verb := noncqr-hm &
  [ SYNSEM.LOCAL.CAT.VAL [ SUBJ < synsem_min & 
                                  [ LOCAL [ CONJ cnil ] ] >,
                           COMPS < synsem & [ OPT - ], ... >,
			   SPCMPS < > ] ].

; DPF 20-Oct-01 - Changed [TAM.ASPECT strict_nonprf] to nonprf, since it was
; blocking coordination of "Kim has arrived and Sandy is happy".  This change
; now allows "Kim is being hiring Browne" but we can live with it for now.
;; 
;; DPF 2022-04-23 - SUBJ..CAT nomp_cat_nom_min over-constrains HEAD to supnoun,
;; so instead just constrain CASE.
be_fin := be_verb &
  [ SYNSEM.LOCAL [ CAT [ HEAD [ VFORM fin,
				PRD -,
				TAM.ASPECT.PRF - ],
			 POSTHD +,
			 VAL.SUBJ < synsem & 
				    [ LOCAL [ CAT.HEAD.CASE nom,
					      CONJ cnil ],
				      OPT - ] > ],
		   CONT psoa ] ].

be_pres := be_fin &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM indic_tam &
                              [ TENSE present,
                                MOOD indicative ],
    ALTS.CSAI - ].

be_past := be_fin &
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD.TAM indic_tam &
                              [ TENSE past ],
    ALTS.CSAI - ].

;; DPF 2022-11-07 - Let's see if we can survive with no extraction from
;; subjunctive copula sentences.
;;
be_subj := be_fin &
  [ INFLECTD +,
    SYNSEM [ LOCAL.CAT.HEAD.TAM subjnct_tam,
	     NONLOC.SLASH.LIST < > ] ].

; Make be_prespart unmarked for PRD so we can block the identity-copula reading
; for "Kim is being good" while allowing the predicative-copula reading.
; 20-Oct-01 - Added POSTHD + to block pre-noun modification as in "*the being
; Kim person arrived"
; Added SLASH 0-dlist to avoid endless recursion when generating, since we no
; longer block "Kim is being silly", and don't want to use VFORM to block
; "Kim is being arriving" since that would put VFORM on type subst (too high),
; even though we'd like to exclude this example.  So we add COMPS..AUX - to
; prevent "*Kim is being being silly", which avoids the worst case.
; DPF 18-oct-03 - Also add COMPS..ASPECT.PROGR - to block *Kim is being singing
; DPF 24-feb-09 - Add NORM norm_rel to prevent N-V compound for "human being"
;; DPF 13-05-09 - Re 20-Oct-01 - Imposing SLASH 0-dlist prevents analysis of
;; e.g. *happily, kim is being admired*, and it seems that we avoid recursion
;; in generation. so removing this constraint.
;;
be_prespart := be_verb &
  [ INFLECTD +,
    SYNSEM [ LOCAL.CAT [ HEAD [ VFORM prp,
                                INV -,
				MINORS.NORM norm_rel ],
                         VAL.COMPS < [ LOCAL.CAT.HEAD.AUX - ], ... >,
                         POSTHD + ] ] ].

be_pastpart := be_verb &
  [ ORTH < "been" >,
    INFLECTD +,
    SYNSEM.LOCAL [ CAT [ HEAD [ TAM.ASPECT.PRF +,
                                PRD -,
                                INV - ],
                         POSTHD + ],
		   CONT psoa ] ]. 
; 2020-12-10
be_neg := sign &
  [ INFLECTD +,
    SYNSEM lex_synsem &
	   [ LOCAL.CONT [ HOOK [ LTOP #ltop,
				 INDEX #nevent ],
                          HCONS.LIST < qeq &
				       [ HARG #arghand,
					 LARG #khand ], ... > ],
	     LKEYS [ KEYREL.LBL #khand,
                     ALT2KEYREL arg01_relation &
                                [ LBL #ltop,
                                  PRED neg_rel,
				  ARG0 #nevent & non_conj_event,
                                  ARG1 #arghand ] ] ] ].

be_be_lex_entry := be_verb & 
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT [ HEAD [ PRD -,
                              TAM.ASPECT.PRF -,
                              INV - ],
                       VAL.SUBJ < synsem & [ OPT -,
					     LOCAL.CAT nomp_cat_min ] > ] ].

be_being_lex_entry := be_prespart &
  [ ORTH < "being" > ].

be_been_lex_entry := be_pastpart & 
  [ ORTH < "been" >,
    SYNSEM.LOCAL.CAT.HEAD.VFORM psp ].

be_pres_lex_entry := be_pres.

be_past_lex_entry := be_past.

be_subj_lex_entry := be_subj.

be_pres_neg_lex_entry := be_pres & be_neg.
be_past_neg_lex_entry := be_past & be_neg.
be_subj_neg_lex_entry := be_subj & be_neg &
  [ ALTS.CSAI - ].

be_am_lex_entry := be_pres_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 1s ] ].

be_is_lex_entry := be_pres_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

be_are_lex_entry := be_pres_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -13s ] ].

be_was_lex_entry := be_past_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 13s ] ].

be_were_lex_entry := be_past_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -13s ] ].

be_was_subjnct_lex_entry := be_subj_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 13s ],
    ALTS.CSAI - ].

be_were_subjnct_lex_entry := be_subj_lex_entry.

; aren't
be_am_neg_contr_lex_entry := be_pres_neg_lex_entry &
  [ SYNSEM.LOCAL [ CAT [ HEAD.INV +,
                         VAL.SUBJ < [ --SIND.PNG #png ] > ],
                   AGR.PNG png & #png & [ PN 1s ] ] ].

; 'm not
be_am_neg_contr_noinv_lex_entry := be_pres_neg_lex_entry & aux_not_contr &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 1s ] ].

; isn't
be_is_neg_contr_lex_entry := be_pres_neg_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

; 's not
be_is_neg_contr_noinv_lex_entry := be_pres_neg_lex_entry & aux_not_contr &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

; aren't
be_are_neg_contr_lex_entry := be_pres_neg_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -13s ] ].

; 're not
be_are_neg_contr_noinv_lex_entry := be_pres_neg_lex_entry & aux_not_contr &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -13s ] ].

be_was_neg_contr_lex_entry := be_past_neg_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 13s ] ].

be_was_subjnct_neg_contr_lex_entry := be_subj_neg_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 13s ] ].

be_were_neg_contr_lex_entry := be_past_neg_lex_entry &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN -13s ] ].

be_were_subjnct_neg_contr_lex_entry := be_subj_neg_lex_entry &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM subjnct_tam ].

; *** Copula BE ***

; DPF 27-Nov-99 - Made KEYREL.LBL identified with COMPS..KEYREL.LBL,
; to avoid assymetry of LBL for VM, which was causing errors
; for e.g. "it is really going to be".  This used to lose a possible ambiguity
; for e.g. "kim is not sleeping", since the support_rel will always be in
; the scope of the negation, regardless of whether the "not" attaches to
; "be" or to the complement phrase.  
; DPF 01-Mar-00 - But now that we've eliminated support_rels, it may work ok.

be_copula := prd_aux_verb_word &
  [ SYNSEM [ LOCAL.CAT [ HEAD.TAM #tam,
			 VAL.COMPS.FIRST.LOCAL.CAT.HEAD.TAM #tam ],
             LKEYS.KEYREL.PRED be_v_prd-or-id_rel ] ].

; 2020-12-10
be_cop_pos_generic := be_copula &
  [ SYNSEM.LOCAL [ CAT.VAL.COMPS.FIRST.LOCAL.CONT.HOOK [ LTOP #ltop,
							 INDEX #index ],
		   CONT [ HOOK [ LTOP #ltop,
				 INDEX #index ],
			  RELS <! !>,
			  HCONS <! !>,
			  ICONS <! !> ] ] ].

be_cop_pos := be_cop_pos_generic.

be_cop_neg := be_copula &
  [ SYNSEM [ LOCAL [ CONT [ HOOK.LTOP #ltop,
                            RELS <! #alt2keyrel !>,
			    HCONS <! qeq !>,
			    ICONS <! !> ] ],
             LKEYS.ALT2KEYREL #alt2keyrel & [ LBL #ltop ] ] ].

vc_prd_be_lexent := be_be_lex_entry & be_cop_pos_generic.

v_prd_be_le := vc_prd_be_lexent &
"""
Cmps Pred-phr, be, bse           
<ex>B will be ready.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT.HEAD.VFORM bse ].

; DPF 18-oct-03 - Added COMPS..ALTMIN no_rel to block "being arriving" while
; still allowing "being hired", "being happy", "being in Berlin"
; DPF 03-oct-06 - But now using ALTMIN to control application of partitive
; rule to superlative adjectives, so need to make this COMPS..ALTMIN more
; specific, to include prd adjs and PPs, but exclude pres-participle verbs,
; so use event_dim_rel.
;; DPF 2017-11-07 - Re 03-oct-06: But this ALTMIN is identified with the 
;; copula's own, and hence has to be compatible with e.g. place_n_rel for 
;; "being here".  So instead constrain compl to be compatible with INV +, 
;; since present participles are INV -, while passives and non-verb 
;; predicatives are unmarked for INV.
;;
v_prd_being_le := be_being_lex_entry & be_cop_pos &
"""
Cmps Pred-phr, be, prp           
<ex>B is being silly.
"""
  [ INFLECTD +,
    SYNSEM.LOCAL.CAT [ HEAD [ PRD +,
                              TAM.ASPECT.PROGR + ],
                       VAL.COMPS.FIRST.LOCAL.CAT.HEAD.INV + ] ].

; For robust variants
vc_prd_been_lexent := be_pastpart & be_cop_pos_generic.
vc_np_been_lexent := be_pastpart & be_id_pos.

v_prd_been_le := be_been_lex_entry & be_cop_pos_generic &
"""
Cmps Pred-phr, be, psp           
<ex>B has been ready.
"""
  [ INFLECTD + ].

v_prd_am_le := be_am_lex_entry & be_cop_pos &
"""
Cmps Pred-phr, be, pr1sg         
<ex>I am ready. 
"""
  [ INFLECTD + ].

v_prd_am-cx_le := be_am_lex_entry & be_cop_pos & contracted_aux_word
"""
Cmps Pred-phr, be, pr1sg, contr  
<ex>I'm ready.  
"""
.

vc_prd_is_lexent := be_is_lex_entry & be_cop_pos.

v_prd_is_le := vc_prd_is_lexent &
"""
Cmps Pred-phr, be, pr3sg         
<ex>B is ready. 
"""
  [ INFLECTD + ].

v_prd_is-cx_le := vc_prd_is_lexent & contracted_aux_word
"""
Cmps Pred-phr, be, pr3sg, contr  
<ex>B's ready.  
"""
.

vc_prd_are_lexent := be_are_lex_entry & be_cop_pos.

v_prd_are_le := vc_prd_are_lexent &
"""
Cmps Pred-phr, be, pr n3sg       
<ex>We are ready.
"""
  [ INFLECTD + ].

v_prd_are-cx_le := vc_prd_are_lexent & contracted_aux_word
"""
Cmps Pred-phr, be, pr n3sg,contr 
<ex>We're ready.
"""
.

vc_prd_was_lexent := be_was_lex_entry & be_cop_pos.

v_prd_was_le := vc_prd_was_lexent &
"""
Cmps Pred-phr, be, past, sg      
<ex>B was ready.  
"""
  [ INFLECTD + ].

v_prd_was-sv_le := be_was_subjnct_lex_entry & be_cop_pos
"""
Cmps Pred-phr, be, subjcv, sg    
<ex>If B was ready, C would be
"""
.

vc_prd_were_lexent := be_were_lex_entry & be_cop_pos.

v_prd_wre_le := vc_prd_were_lexent &
"""
Cmps Pred-phr, be, past, plural  
<ex>We were ready.            
"""
  [ INFLECTD + ].

v_prd_wre-sv_le := be_were_subjnct_lex_entry & be_cop_pos &
"""
Cmps Pred-phr, be, subjcv, plur  
<ex>If we were ready, C'd be. 
"""
  [ INFLECTD + ].

v_prd_am-n_le := be_am_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, pr1sg,ngc,inv 
<ex>Aren't I ready?           
"""
.

v_prd_am-n-niv_le := be_am_neg_contr_noinv_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be,pr1sg,ngc,ninv 
<ex>I'm not.            
"""
.

v_prd_am-aint_le := be_pres_neg_lex_entry & be_cop_neg &
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 1s ] ].

v_prd_is-n_le := be_is_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, pr3sg, contr  
<ex>B's not ready.            
"""
.

v_prd_is-n-niv_le := be_is_neg_contr_noinv_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be,pr3s,cntr,ninv 
<ex>B isn't ready.            
"""
.

v_prd_are-n_le := be_are_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, prn3sg, contr 
<ex>We're not ready.          
"""
.

v_prd_are-n-niv_le := be_are_neg_contr_noinv_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be,prn3s,ctr,ninv 
<ex>We aren't ready.          
"""
.

v_prd_was-n_le := be_was_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, pastsg, ngc   
<ex>B wasn't ready.           
"""
.

v_prd_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, subjcv,sg,ngc 
<ex>If B wasn't ready, C'd be.
"""
.

v_prd_wre-n_le := be_were_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, pastpl, ngc   
<ex>We weren't ready.         
"""
.

v_prd_wre-n-sv_le := be_were_subjnct_neg_contr_lex_entry & be_cop_neg
"""
Cmps Pred-phr, be, subjcv,pl,ngc 
<ex>If we weren't, C'd be.
"""
.

; *** Identity BE ***
; For now, exclude gerundive complements, to avoid semantically anomalous
; reading for "Kim is sleeping"
; DPF 08-Jan-00 Made COMP be nom_rel instead of reg_nom_rel, to allow "Tuesday
; is my last day" and "that's him".
; DPF 22-Feb-01 - Added ALTMIN restriction on SUBJ to prevent free relatives
; from appearing in subject position, to get the contrast of "I admire what
; you are" vs. "*I admire what are you" (and cf. "I admire what is best").
; DPF 26-Aug-01 - Added MIN nom_rel to SUBJ, like for COMP, to avoid having
; measure_nps in subject position.
; DPF 19-Oct-02 - Removed identification of PT on SUBJ and COMP, since
; this blocks "it is I/me" "that's me" etc.
; DPF 27-Apr-03 - Removed [COMPS..PRD -] since this prevents 'today is December
; third', and it's not clear what it was blocking.  (Nor is it clear why
; 'third' has to be [PRD +].)
; DPF 10-Jun-03 - Try identifying SORT values of subj and comp.
; DPF 5-Sep-03 - Don't understand comment of 22-Feb-02 above, but clearly
; free relatives can be subjects of identity copula: "What he does is your
; problem".  So removed this constraint.
; DPF 18-dec-03 - Keeping identity of SORT values is too hard - e.g. "The
; cabin is a good place to stay".  
; DPF 30-aug-04 - Removed PT real_pron from SUBJ, since it
; prevented "consultant hiring is a disadvantage" with N-N-cmpnd subject NP.
; Leave on COMPS for now, to continue to block spurious analysis for
; "the boy is fishing."
; DPF 19-nov-04 - Removed identification of SUBJ..AGR with SUBJ..--SIND since
; want "three kilometers" measure-NP to be syntactically singular, even though
; semantic index comes from "kilometers" which is plural.
; DPF 05-nov-05 - Added CASE non_obliq to COMPS to block idiomatic detless NPs
; as in 'on top' from giving "*Kim is top."
; DPF 13-nov-05 - But sadly this also blocks "This is why we suffer".  So
; instead try requiring non-empty SPEC, where detless NPs have SPEC < >.
; DPF 28-oct-06 - Removed PT real_pron from COMPS, since we want to
; allow "The reason is the fishing."  No longer getting as much spurious
; ambiguity, for example with "The boy is fishing."  See if too much remains.
; DPF 25-may-10 - Re 13-nov-05: No longer necessary, and SPEC *cons* was
; blocking "the cost is $100."
; DPF 04-jun-10 - Added COMPS..CASE non_obliq to prevent bare-sg nouns in PET,
; as in "*Kim is being in Paris"
; DPF 2010-sept-08 - Re 04-jun-10: But we also want to use CASE to exclude
; spurious analysis for "Where is Kim".  So change CASE to nom_or_obliq, and
; instead use HEAD mobile to exclude bare-sg nouns in PET (which does not
; currently attend to constraints in idioms.tdl).
;; DPF 2018-06-01 - Constrained COMPS..INDEX to non_expl_ind, to avoid mostly
;; spurious ambiguity with elided copula *be*, which can only be syntactically
;; resolved in tag questions.  To still get *he is Browne, isn't he*, changed
;; the MIN value of predicative copula to be_v_prd-or-id_rel, so it will also
;; unify with id-copula requirement of main clause in *he is Browne, isn't he*.
;; DPF 2020-04-01 - Re 18-dec-03: We have managed to keep this identity for
;; a good while, but note that it also blocks
;; *the cuts were a streamlining of operations*.  FIX someday.
;; DPF 2022-05-19 - Re 2020-04-01: Requiring SORT identity loses us some
;; examples, such as "The retrofitting was part of a planned reinforcement".
;; But removing SORT is costly, since it opens up the ambiguity of
;; "Kim is reading a book".  So let's live with slightly reduced coverage
;; for a significant gain in efficiency.
;;
aux_np_verb := aux_verb & basic_two_arg & two_arg_subst &
  [ LOCAL [ CAT [ HEAD.MINORS [ MIN be_v_id_rel,
				ALTMIN nonpass_rel ],
                  VAL [ SUBJ < [ --MIN nom_or_mnp_rel,
                                 --SIND #id1ind & basic_non_expl &
                                       [ SORT #sort ],
                                 NONLOC non-local_norel ] >,
                        COMPS < [ --MIN nom_or_mnp_rel,
                                  LOCAL [ CAT [ HEAD supnoun & mobile &
						     [ POSS -,
						       MOD *anti_list*,
						       CASE nom_or_obliq ],
						VAL [ SUBJ *olist*,
						      SPR *olist*,
						      COMPS < > ],
						MC na_or_- ],
					  CONJ cnil ],
                                  --SIND #id2ind & non_expl-ind &
                                        [ SORT #sort ],
                                  NONLOC.REL.LIST < > ] > ] ],
            CONT.HOOK.XARG #id1ind ],
    LKEYS.KEYREL arg12_relation &
                 [ ARG0 non_conj_event,
		   ARG1 #id1ind,
                   ARG2 #id2ind ] ].

; Note: redefined in lextypes-epgy.tdl
; 2020-12-10
be_id := be_verb &
  [ SYNSEM aux_np_verb &
	   [ LOCAL [ CAT [ VAL [ SUBJ.FIRST.LOCAL [ CAT nomp_cat_min,
						    CONT.HOOK.LTOP #ltop ],
				 COMPS < [ LOCAL [ CAT.HEAD.--BARE -,
						   CONT.HOOK.LTOP #ltop ]] >]]],
	     LKEYS.KEYREL [ LBL #ltop,
			    PRED _be_v_id_rel ] ] ].

; 2020-12-10
;; DPF 2022-05-20 - Pushed [PROGR -] down to subtype, since we need it still
;; unmarked for |He denied having been the source|
;;
basic_be_id_pos := be_id &
  [ SYNSEM [ LOCAL [ CONT [ HOOK [ LTOP #ltop,
				   INDEX #event ],
			    RELS <! #keyrel !>,
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop,
				      ARG0 #event ] ] ].

be_id_pos := basic_be_id_pos &
  [ SYNSEM.LOCAL.CAT.HEAD.TAM.ASPECT.PROGR - ].

be_id_neg_synsem := aux_np_verb &
  [ LKEYS.KEYREL.PRED _be_v_id_rel,
    LOCAL.CAT.VAL.COMPS < [ LOCAL.CAT.HEAD.--BARE - ] > ].

; 2020-12-10
be_id_neg := be_id &
  [ SYNSEM be_id_neg_synsem & 
	   [ LOCAL [ CAT.HEAD.TAM.ASPECT.PROGR -,
		     CONT [ HOOK.INDEX #nevent & non_conj_event,
			    RELS <! #keyrel, #alt2keyrel !>,
			    HCONS <! qeq !>,
			    ICONS <! !> ] ],
             LKEYS [ KEYREL #keyrel,
                     ALT2KEYREL #alt2keyrel & [ ARG0 #nevent ] ] ] ].

vc_np_be_lexent := be_be_lex_entry & be_id &
  [ SYNSEM [ LOCAL [ CAT.HEAD.TAM.ASPECT.PROGR -,
		     CONT [ HOOK [ LTOP #ltop,
				   INDEX #index ],
			    RELS <! #keyrel !>,
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop,
				      ARG0 #index ] ] ].
v_np_be_lexent := vc_np_be_lexent &
  [ SYNSEM.LOCAL.CAT.HEAD.VFORM bse ].

v_np_be_le := v_np_be_lexent
"""
Cmps NP, be, bse                 
<ex>B will be C. 
"""
.

v_np_being_le := be_being_lex_entry & be_id &
"""
Cmps NP, be, prp                 
<ex>B is being C. 
"""
  [ SYNSEM [ LOCAL [ CAT.HEAD.TAM.ASPECT.PROGR +,
		     CONT [ HOOK [ LTOP #ltop,
				   INDEX #index ],
			    RELS <! #keyrel !>,
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop,
				      ARG0 #index ] ] ].

v_np_been_le := be_been_lex_entry & basic_be_id_pos
"""
Cmps NP, be, psp                 
<ex>B has been C.
"""
.

v_np_am_le := be_am_lex_entry & be_id_pos &
"""
Cmps NP, be, pr1sg               
<ex>I am C. 
"""
  [ INFLECTD + ].

v_np_am-cx_le := be_am_lex_entry & be_id_pos & contracted_aux_word
"""
Cmps NP, be, pr1sg, contr        
<ex>I'm C.  
"""
.

v_np_is_le := be_is_lex_entry & be_id_pos &
"""
Cmps NP, be, pr3sg               
<ex>B is C. 
"""
  [ INFLECTD + ].

v_np_is-cx_le := be_is_lex_entry & be_id_pos & contracted_aux_word
"""
Cmps NP, be, pr3sg, contr        
<ex>B's C.  
"""
.

v_np_are_le := be_are_lex_entry & be_id_pos &
"""
Cmps NP, be, pr n3sg             
<ex>We are C
"""
  [ INFLECTD + ].

v_np_are-cx_le := be_are_lex_entry & be_id_pos & contracted_aux_word
"""
Cmps NP, be, pr n3sg,contr       
<ex>We're C.
"""
.

v_np_was_le := be_was_lex_entry & be_id_pos
"""
Cmps NP, be, past, sg            
<ex>B was C.  
"""
.

v_np_was-sv_le := be_was_subjnct_lex_entry & be_id_pos
"""
Cmps NP, be, subjct, sg          
<ex>If B was C, D would be.
"""
.

v_np_wre_le := be_were_lex_entry & be_id_pos
"""
Cmps NP, be, past, plural        
<ex>We were C.            
"""
.

v_np_wre-sv_le := be_were_subjnct_lex_entry & be_id_pos
"""
Cmps NP, be, subjct, plur        
<ex>If we were C, D'd be. 
"""
.


v_np_am-n_le := be_am_neg_contr_lex_entry & be_id_neg
"""
Cmps NP, be, pr1sg,ngc,inv       
<ex>Aren't I C?           
"""
.

v_np_am-n-niv_le := be_am_neg_contr_noinv_lex_entry & be_id_neg
"""
Cmps NP, be,pr1sg,ngc,ninv       
<ex>I'm not C.            
"""
.

v_np_is-n_lexent := be_is_neg_contr_lex_entry & be_id_neg.

v_np_is-n_le := v_np_is-n_lexent
"""
Cmps NP, be, pr3sg, contr        
<ex>B isn't C.            
"""
.

v_np_is-n-niv_le := be_is_neg_contr_noinv_lex_entry & be_id_neg
"""
Cmps NP, be,pr3s,cntr,ninv, elided or gap complement       
<ex>B's not.            
<ex>A genius, he's not.
"""
.

v_np_are-n_lexent := be_are_neg_contr_lex_entry & be_id_neg.

v_np_are-n_le := v_np_are-n_lexent
"""
Cmps NP, be, prn3sg, contr       
<ex>We aren't C.          
"""
.

v_np_are-n-niv_le := be_are_neg_contr_noinv_lex_entry & be_id_neg
"""
Cmps NP, be,prn3s,ctr,ninv       
<ex>We're not C.          
"""
.

v_np_was-n_lexent := be_was_neg_contr_lex_entry & be_id_neg.

v_np_was-n_le := v_np_was-n_lexent
"""
Cmps NP, be, pastsg, ngc         
<ex>B wasn't C.           
"""
.

v_np_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & be_id_neg
"""
Cmps NP, be, subjct,sg,ngc       
<ex>If B wasn't C, D'd be.
"""
.

v_np_wre-n_lexent := be_were_neg_contr_lex_entry & be_id_neg.

v_np_wre-n_le := v_np_wre-n_lexent
"""
Cmps NP, be, pastpl, ngc         
<ex>We weren't C.         
"""
.

v_np_wre-n-sv_le := be_were_subjnct_neg_contr_lex_entry & be_id_neg
"""
Cmps NP, be, subjct,pl,ngc       
<ex>If we weren't, C'd be.xo
"""
.

; Note that for "it's because Kim arrived." the ARG1 of the subord_rel is
; incorrectly not bound to any lbl.  Awkward to get right, since no handle
; for "the reason is because Kim arrived".  FIX...
; DPF 13-may-08 - Removed --COMPHD comp_or_p because we also want to
; get "The short answer is nobody wins."  So far this was the only use of
; the feature, so maybe discard.
; DPF 27-may-08 - Added POSTHD + to block spurious analysis for
; "Kim is of programmers."
; DPF 23-apr-09 - Added ALTMIN aux_event_rel to prevent *being* from 
; undergoing adj_attr_verb_tr_part lexical rule as in *the being six*
;; DPF 2012-11-09 - Added COMPS..LEX - to prevent spurious reading of
;; *that was so.*
;; DPF 2016-09-12 - Removed COMPS..INDEX.--TPC - because we also want
;; *the idea is that in Paris we eat well*.  FIX? whatever the consequences are.
;; DPF 2016-12-14 - Removed SUBJ..SORT nom-event, since we also want to allow
;; *what Kim said was that he disappeared* where the CP-WH NP now has sort
;; q-event.  If this is too permissive, we can define a new supertype for
;; nom-or-q-event, but we also get more robustness for subject-heading nouns
;; that are not explicitly neutral about their SORT type, as in
;; *the best hint was that Kim disappeared*
;; DPF 2017-05-10 - Removed COMPS..SUBJ *anti_list* so we can get the desired
;; second reading for *the plan is to leave early* contrasted with the most
;; likely and already available reading for *Kim is to leave early*.
;; DPF 2017-10-02 - Constrain SUBJ..MIN to non_proper_rel (was nom_or_mnp_rel),
;; to avoid *Kim is we arise*
;; DPF 2017-10-03 - Restrict these to subj NPs underspec for SORT, so we can
;; avoid *Kids are [[on their cell phones][they disrupt class]]*
;; DPF 2017-10-31 - Re 2017-10-02: Need to also allow pronoun "it" here, as in
;; *if there's a problem, it is that we are too busy*
;; DPF 2020-04-01 - Removed COMPS..MODIFD notmod_or_rmod since we want
;; *the belief is [if we try, we will succeed]*.  CHECK.
;; DPF 2020-04-29 - Remove comp's NONLOC non-local_none and subj's identif of 
;; NONLOC with mother, to get analysis for *how is it that he disappeared?*
;; but need to also constrain SLASH to only adjuncts, to avoid spurious
;; analysis for e.g. *We arrive every time the ad is arises* with subj 
;; extracted from *arises*
;; DPF 2020-04-29 - Tempting to add MOOD ind_or_modal_subj to COMPS, to avoid
;; ambiguity with *that they arrive*, but we need subjunctive for e.g.
;; *the idea is that he be spared the embarrassment*
;; DPF 2021-06-24 - Tried making XARG of complement reentrant with own XARG,
;; but of course this fails for e.g. "the problem is that he arrived",so remove.
;; DPF 2024-05-03 - Constrain subj to be --SIND non_expl-ind to avoid spurious
;; analysis for e.g. "there were windows open"
;;
basic_nv_cop_verb := aux_verb & two_arg_subst & basic_two_arg & 
		     cp_addin_tam_pn &
  [ LOCAL [ CAT [ HEAD.MINORS [ MIN be_v_nv_rel,
				ALTMIN aux_event_rel ],
                  VAL [ SUBJ < synsem_min &
			       [ LOCAL [ CAT nomp_cat_min,
					 CONT.HOOK.LTOP #ltop ],
				 --MIN non_proper_rel,
                                 --SIND #idind & non_expl-ind ] >,
                        COMPS < canonical_synsem &
				[ --MIN verb_or_subord_rel,
                                  LOCAL [ CAT [ HEAD verbal_or_p &
						  [ MINORS.NORM norm_rel,
						    PRD -,
						    TAM #tam,
						    --ADDIN [ ADDPN #pn,
							      ADDTAM #tam ] ],
						VAL [ COMPS < > ],
						MC na_or_- ],
					  AGR.PNG.PN #pn,
                                          CONT.HOOK 
					   [ LTOP #cltop,
					     INDEX.SF prop-or-ques,
					     XARG.SORT basic-entity-or-event  ],
					  CONJ cnil ],
				  LEX -,
                                  NONLOC non-local_none ] > ] ],
	    CONT.HOOK [ LTOP #ltop,
			XARG #idind ] ],
    LKEYS.KEYREL arg12_relation &
                 [ PRED _be_v_nv_rel,
		   ARG0 non_conj_event,
                   ARG1 #idind,
                   ARG2 #cltop ] ].

;; DPF 2024-04-25 - Allow MC na modifiee for v-vp verbs as in 
;;"the idea is never to quit"
nv_cop_verb := basic_nv_cop_verb &
  [ LOCAL.CAT.VAL.COMPS < [ LOCAL.CAT.MC - ] > ].

basic_be_nv := be_verb &
  [ SYNSEM basic_nv_cop_verb,
    ALTS.VPELLIP - ].

be_nv := basic_be_nv &
  [ SYNSEM nv_cop_verb ].

basic_be_nv_pos := basic_be_nv &
  [ SYNSEM [ LOCAL [ CAT.HEAD.TAM.ASPECT.PROGR -,
		     CONT [ HOOK [ LTOP #ltop,
				   INDEX #event ],
			    RELS.LIST.FIRST #keyrel & [ ARG0 #event ],
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop ] ] ].

be_nv_pos := basic_be_nv_pos & be_nv &
  [ SYNSEM.LOCAL.CONT.RELS <! relation !> ].

be_sc_pos := basic_be_nv_pos &
  [ SYNSEM [ LOCAL [ CAT.VAL.COMPS.FIRST.LOCAL.CONT.HOOK.XARG #lbl,
		     CONT.RELS <! [ CFROM #from, CTO #to ],
				  [ LBL #lbl,
				    PRED ellipsis_rel,
				    ARG0 event,
				    CFROM #from, CTO #to ] !> ],
	     LKEYS [ --COMPKEY #cmin & subord_rel,
		     --+COMPKEY #cmin ] ] ].

; 2020-12-10
basic_be_nv_neg := basic_be_nv &
  [ SYNSEM basic_nv_cop_verb & 
	   [ LOCAL [ CAT.HEAD.TAM.ASPECT.PROGR -,
		     CONT [ HOOK.INDEX #nevent,
			    RELS.LIST < #keyrel, #alt2keyrel, ... >,
			    HCONS <! qeq !>,
			    ICONS <! !> ] ],
             LKEYS [ KEYREL #keyrel,
                     ALT2KEYREL #alt2keyrel & [ ARG0 #nevent ] ] ] ].

be_nv_neg := basic_be_nv_neg & be_nv &
  [ SYNSEM nv_cop_verb & 
	   [ LOCAL.CONT.RELS <! relation, relation !> ] ].

be_sc_neg := basic_be_nv_neg & be_nv &
  [ SYNSEM [ LOCAL [ CAT.VAL.COMPS.FIRST.LOCAL.CONT.HOOK.XARG #lbl,
		     CONT.RELS <! [ CFROM #from, CTO #to ], relation,
				  [ LBL #lbl,
				    PRED ellipsis_rel,
				    ARG0 event,
				    CFROM #from, CTO #to ] !> ],
	     LKEYS [ --COMPKEY #cmin & subord_rel,
		     --+COMPKEY #cmin ] ] ].

;; *The idea is that Kim wins*
cp_cop_verb := nv_cop_verb &
  [ LOCAL.CAT.VAL.COMPS.FIRST.LOCAL.CAT [ HEAD verbal,
					  VAL.SUBJ *anti_list* ] ].

;; subord_clause, where RELS adds a placeholder EP for the subord's missing ARG1
;; *the reason is because Kim lost*
sc_cop_verb := nv_cop_verb &
  [ LOCAL.CAT.VAL.COMPS.FIRST.LOCAL.CAT [ HEAD prep,
					  VAL.SUBJ *anti_list* ] ].

;; *the idea is to win*
vp_cop_verb := basic_nv_cop_verb &
  [ LOCAL.CAT.VAL.COMPS.FIRST.LOCAL.CAT [ HEAD.VFORM inf,
					  VAL.SUBJ.FIRST synsem ] ].

vp_cop_verb_pos := vp_cop_verb &
  [ LOCAL.CONT.RELS <! relation !> ].

vp_cop_verb_neg := vp_cop_verb &
  [ LOCAL.CONT.RELS <! relation, relation !> ].

basic_v_cpvp_be_lexent := be_be_lex_entry & basic_be_nv &
  [ SYNSEM [ LOCAL [ CAT.HEAD [ TAM.ASPECT.PROGR -,
				VFORM bse ],
		     CONT [ HOOK.LTOP #ltop,
			    RELS.LIST.FIRST #keyrel,
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop ] ] ].

v_cpvp_be_lexent := basic_v_cpvp_be_lexent &
  [ SYNSEM.LOCAL.CONT.RELS <! relation !> ].

v_cp_be_lexent := v_cpvp_be_lexent &
  [ SYNSEM cp_cop_verb ].

v_cp_be_le := v_cp_be_lexent
"""
Cmps S, be, bse                  
<ex>The plan'll be that C wins
"""
.

;; Subord clause complement
v_sc_be_le := basic_v_cpvp_be_lexent &
"""
Cmps SC, be, bse                  
<ex>The reason'll be because C wins
"""
  [ SYNSEM sc_cop_verb &
	   [ LOCAL [ CAT.VAL.COMPS.FIRST.LOCAL.CONT.HOOK.XARG #lbl,
		     CONT.RELS <! [ CFROM #from, CTO #to ],
			          [ LBL #lbl,
				    PRED ellipsis_rel,
				    ARG0 event,
				    CFROM #from, CTO #to ] !> ],
	     LKEYS [ --COMPKEY #cmin & subord_rel,
		     --+COMPKEY #cmin ] ] ].

basic_v_cpvp_being_lexent := be_being_lex_entry & basic_be_nv &
  [ SYNSEM [ LOCAL [ CAT.HEAD.TAM.ASPECT.PROGR +,
		     CONT [ HOOK.LTOP #ltop,
			    RELS.LIST.FIRST #keyrel,
			    HCONS <! !>,
			    ICONS <! !> ] ],
             LKEYS.KEYREL #keyrel & [ LBL #ltop ] ] ].

v_cpvp_being_lexent := basic_v_cpvp_being_lexent &
  [ SYNSEM.LOCAL.CONT.RELS <! relation !> ].

v_cp_being_le := v_cpvp_being_lexent &
"""
Cmps S, be, prp                  
<ex>The plan being C won, I do
"""
  [ SYNSEM cp_cop_verb ].

;; Subord clause complement
v_sc_being_le := basic_v_cpvp_being_lexent &
"""
Cmps SC, be, prp                  
<ex>The reason being because C won, I do
"""
  [ SYNSEM sc_cop_verb & 
	   [ LOCAL [ CAT.VAL.COMPS.FIRST.LOCAL.CONT.HOOK.XARG #lbl,
		     CONT.RELS <! [ CFROM #from, CTO #to ],
			          [ LBL #lbl,
				    PRED ellipsis_rel,
				    ARG0 event,
				    CFROM #from, CTO #to ] !> ],
	     LKEYS [ --COMPKEY #cmin & subord_rel,
		     --+COMPKEY #cmin ] ] ].


v_cp_been_le := be_been_lex_entry & be_nv_pos &
"""
Cmps S, be, psp                  
<ex>The plan'd been that C won
"""
  [ SYNSEM cp_cop_verb ].

v_cp_is_le := be_is_lex_entry & be_nv_pos &
"""
Cmps S, be, pr3sg                
<ex>The plan is that C won.
"""
  [ INFLECTD +,
    SYNSEM cp_cop_verb ].

v_cp_is-cx_le := be_is_lex_entry & be_nv_pos & contracted_aux_word &
"""
Cmps S, be, pr3sg, contr         
<ex>The plan's that C won.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_are_le := be_are_lex_entry & be_nv_pos &
"""
Cmps S, be, pr n3sg              
<ex>The plans are that C wins.
"""
  [ INFLECTD +,
    SYNSEM cp_cop_verb ].

v_cp_was_le := be_was_lex_entry & be_nv_pos &
"""
Cmps S, be, past, sg             
<ex>The plan was that C won.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_was-sv_le := be_was_subjnct_lex_entry & be_nv_pos &
"""
Cmps S, be, subjct, sg           
<ex>If the plan was S, D would
"""
  [ SYNSEM cp_cop_verb ].

v_cp_wre_le := be_were_lex_entry & be_nv_pos &
"""
Cmps S, be, past, subjunctive
<ex>We prefer that the plan were that C won.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_wre-sv_le := be_were_subjnct_lex_entry & be_nv_pos &
"""
Cmps S, be, subjct, plur         
<ex>If plans were S, D'd be. 
"""
  [ SYNSEM cp_cop_verb ].

v_cp_is-n_le := be_is_neg_contr_lex_entry & be_nv_neg &
"""
Cmps S, be, pr3sg, contr         
<ex>The plan isn't that S.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_are-n_le := be_are_neg_contr_lex_entry & be_nv_neg &
"""
Cmps S, be, prn3sg, contr        
<ex>The plans aren't that S.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_was-n_le := be_was_neg_contr_lex_entry & be_nv_neg &
"""
Cmps S, be, pastsg, ngc          
<ex>The plan wasn't that S.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & be_nv_neg &
"""
Cmps S, be, subjct,sg,ngc        
<ex>If the plan wasn't S, C is
"""
  [ SYNSEM cp_cop_verb ].

v_cp_wre-n_le := be_were_neg_contr_lex_entry & be_nv_neg &
"""
Cmps S, be, pastpl, ngc          
<ex>The plans weren't that S.
"""
  [ SYNSEM cp_cop_verb ].

v_cp_wre-n-sv_le := be_were_subjnct_neg_contr_lex_entry & be_nv_neg &
"""
Cmps S, be, subjct,pl,ngc        
<ex>If plans weren't, C'd go.
"""
  [ SYNSEM cp_cop_verb ].

;; Next, subord clause complement variants

v_sc_been_le := be_been_lex_entry & be_sc_pos &
"""
Cmps SC, be, psp                  
<ex>The reason'd been because C won
"""
  [ SYNSEM sc_cop_verb ].

v_sc_is_le := be_is_lex_entry & be_sc_pos &
"""
Cmps SC, be, pr3sg                
<ex>The reason is because C won.
"""
  [ INFLECTD +,
    SYNSEM sc_cop_verb ].

v_sc_is-cx_le := be_is_lex_entry & be_sc_pos & contracted_aux_word &
"""
Cmps SC, be, pr3sg, contr         
<ex>The reason's because C won.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_are_le := be_are_lex_entry & be_sc_pos &
"""
Cmps SC, be, pr n3sg              
<ex>The reasons are because C wins.
"""
  [ INFLECTD +,
    SYNSEM sc_cop_verb ].

v_sc_was_le := be_was_lex_entry & be_sc_pos &
"""
Cmps SC, be, past, sg             
<ex>The reason was because C won.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_was-sv_le := be_was_subjnct_lex_entry & be_sc_pos &
"""
Cmps SC, be, subjct, sg           
<ex>If the reason was because C won, D would
"""
  [ SYNSEM sc_cop_verb ].

v_sc_wre_le := be_were_lex_entry & be_sc_pos &
"""
Cmps SC, be, past, subjunctive
<ex>We prefer that the reason were because C won.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_wre-sv_le := be_were_subjnct_lex_entry & be_sc_pos &
"""
Cmps SC, be, subjct, plur         
<ex>If reasons were because C won, D'd be. 
"""
  [ SYNSEM sc_cop_verb ].

v_sc_is-n_le := be_is_neg_contr_lex_entry & be_sc_neg &
"""
Cmps SC, be, pr3sg, contr         
<ex>The reason isn't because S.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_are-n_le := be_are_neg_contr_lex_entry & be_sc_neg &
"""
Cmps SC, be, prn3sg, contr        
<ex>The reasons aren't because S.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_was-n_le := be_was_neg_contr_lex_entry & be_sc_neg &
"""
Cmps SC, be, pastsg, ngc          
<ex>The reason wasn't because S.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & be_sc_neg &
"""
Cmps SC, be, subjct,sg,ngc        
<ex>If the reason wasn't because S, C is
"""
  [ SYNSEM sc_cop_verb ].

v_sc_wre-n_le := be_were_neg_contr_lex_entry & be_sc_neg &
"""
Cmps SC, be, pastpl, ngc          
<ex>The reasons weren't because S.
"""
  [ SYNSEM sc_cop_verb ].

v_sc_wre-n-sv_le := be_were_subjnct_neg_contr_lex_entry & be_sc_neg &
"""
Cmps SC, be, subjct,pl,ngc        
<ex>If reasons weren't because D, C'd go.
"""
  [ SYNSEM sc_cop_verb ].

;; Now the VP complement variants as in *the idea is to win*

v_vp_be_le := v_cpvp_be_lexent &
"""
Cmps VP, be, bse                  
<ex>The plan'll be to win
"""
  [ SYNSEM vp_cop_verb ].

v_vp_being_le := v_cpvp_being_lexent &
"""
Cmps VP, be, prp                  
<ex>The plan being to win, I do
"""
  [ SYNSEM vp_cop_verb ].

v_vp_been_le := be_been_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, psp                  
<ex>The plan'd been to win
"""
  [ SYNSEM vp_cop_verb_pos ].

v_vp_is_le := be_is_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, pr3sg                
<ex>The plan is to win
"""
  [ INFLECTD +,
    SYNSEM vp_cop_verb_pos ].

v_vp_is-cx_le := be_is_lex_entry & basic_be_nv_pos & contracted_aux_word &
"""
Cmps VP, be, pr3sg, contr         
<ex>The plan's to win
"""
  [ SYNSEM vp_cop_verb_pos ].

v_vp_are_le := be_are_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, pr n3sg              
<ex>The plans are to win
"""
  [ INFLECTD +,
    SYNSEM vp_cop_verb_pos ].

v_vp_was_le := be_was_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, past, sg             
<ex>The plan was to win
"""
  [ SYNSEM vp_cop_verb_pos ].

v_vp_was-sv_le := be_was_subjnct_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, subjct, sg           
<ex>If the plan was to win, D would.
"""
  [ SYNSEM vp_cop_verb_pos ].

v_vp_wre_le := be_were_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, past, subjunctive
<ex>We prefer that the plan were to win
"""
  [ SYNSEM vp_cop_verb_pos ].

v_vp_wre-sv_le := be_were_subjnct_lex_entry & basic_be_nv_pos &
"""
Cmps VP, be, subjct, plur         
<ex>If plans were to win, D'd be. 
"""
  [ SYNSEM vp_cop_verb_pos ].

v_vp_is-n_le := be_is_neg_contr_lex_entry & basic_be_nv_neg &
"""
Cmps VP, be, pr3sg, contr         
<ex>The plan isn't to win
"""
  [ SYNSEM vp_cop_verb_neg ].

v_vp_are-n_le := be_are_neg_contr_lex_entry & basic_be_nv_neg &
"""
Cmps VP, be, prn3sg, contr        
<ex>The plans aren't to win
"""
  [ SYNSEM vp_cop_verb_neg ].

v_vp_was-n_le := be_was_neg_contr_lex_entry & basic_be_nv_neg &
"""
Cmps VP, be, pastsg, ngc          
<ex>The plan wasn't to win
"""
  [ SYNSEM vp_cop_verb_neg ].

v_vp_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & basic_be_nv_neg &
"""
Cmps VP, be, subjct,sg,ngc        
<ex>If the plan wasn't to win, C is
"""
  [ SYNSEM vp_cop_verb_neg ].

v_vp_wre-n_le := be_were_neg_contr_lex_entry & basic_be_nv_neg &
"""
Cmps VP, be, pastpl, ngc          
<ex>The plans weren't to win
"""
  [ SYNSEM vp_cop_verb_neg ].

v_vp_wre-n-sv_le := be_were_subjnct_neg_contr_lex_entry & basic_be_nv_neg &
"""
Cmps VP, be, subjct,pl,ngc        
<ex>If plans weren't, C'd go.
"""
  [ SYNSEM vp_cop_verb_neg ].

; *** There Copula BE ***

;; The relationship between the first COMP and the second cannot be one of
;; raising (since if the first is extracted its SLASH will be non-empty, and
;; that non-empty SLASH would also erroneously appear on the VP.  So the 
;; control relation must be equi rather than raising.
;; DPF 2-May-01 - HACK: To avoid spurious ambiguity temporarily, block second 
;; arg by changing its MIN from independent_rel to no_rel.
;; DPF 29-may-07 - Removed AUX + to allow extraction of modifiers, as for
;; "occasionally there are unicorns in the garden".  FIX?

there_cop_verb := there_verb_synsem & aux_verb &
  [ LOCAL.CAT [ HEAD.MINORS.MIN be_v_there_rel,
		VAL.SUBJ.FIRST.LOCAL.CAT nomp_cat_min ],
    LKEYS [ KEYREL.PRED _be_v_there_rel,
            --+ARGIND there-ind ] ].

be_th_cop := be_verb & 
  [ SYNSEM there_cop_verb & 
	   [ LOCAL.CAT [ VAL.COMPS.FIRST.LOCAL.CONT.HOOK.LTOP #ltop ],
	     LKEYS.KEYREL.LBL #ltop ] ].

be_th_cop_pos := be_th_cop &
  [ SYNSEM [ LOCAL.CONT [ HOOK [ LTOP #ltop,
				 INDEX #event ],
			  RELS <! #keyrel !>,
			  HCONS <! !>,
			  ICONS <! !> ],
	     LKEYS.KEYREL #keyrel & [ LBL #ltop,
				      ARG0 #event ] ] ].

; 2020-12-10
be_th_cop_neg := be_th_cop &
  [ SYNSEM [ LOCAL.CONT [ HOOK [ LTOP #ltop,
                                 INDEX #nevent ],
                          RELS <! #keyrel, #alt2keyrel !>,
			  HCONS <! qeq !>,
			  ICONS <! !> ],
             LKEYS [ KEYREL #keyrel,
                     ALT2KEYREL #alt2keyrel & [ LBL #ltop,
						ARG0 #nevent ] ] ] ].

v_np-xp_be_lexent := be_be_lex_entry & be_th_cop_pos &
  [ SYNSEM.LOCAL.CAT.HEAD.VFORM bse_only ].

v_np-xp_be_le := v_np-xp_be_lexent
"""
Cmps NP,Prd-p, be,ex-s,bse       
<ex>There will be music.
"""
.

;; DPF 2022-05-25 - Not clear why this was [PRD -], but that blocked verbal
;; gerunds such as "he relied on there being a quick solution".  So remove,
;; and check.
v_np-xp_being_le := be_being_lex_entry & be_th_cop_pos &
"""
Cmps NP,Prd-p, be,ex-s,prp       
<ex>There being music, C went.
"""
  [ SYNSEM.LOCAL.CAT.HEAD [ TAM.ASPECT.PROGR - ] ].

v_np-xp_been_le := be_been_lex_entry & be_th_cop_pos
"""
Cmps NP,Prd-p, be,ex-s,psp       
<ex>There has been music.
"""
.

vc_there_is_lexent := be_is_lex_entry & be_th_cop_pos.

v_np-xp_is_le := vc_there_is_lexent &
"""
Cmps NP,Prd-p, be,ex-s,prsg      
<ex>There is music.
"""
  [ INFLECTD + ].

vc_there_are_lexent := be_are_lex_entry & be_th_cop_pos.
v_np-xp_are_le := vc_there_are_lexent &
"""
Cmps NP,Prd-p, be,ex-s,prpl      
<ex>There are songs.
"""
  [ INFLECTD + ].

v_np-xp_is-pl_le := vc_there_are_lexent &
"""
Cmps NP,Prd-p, be,ex-s ispl      
<ex>There is music and food.
"""
  [ INFLECTD +,
    ALTS.VPELLIP -,
    GENRE nonformal ].

; DPF 04mar10 - Returned to using parent be_was_lex_entry rather than 
; be_past_lex_entry, to block "there was cats in the garden".
vc_there_was_lexent := be_was_lex_entry & be_th_cop_pos.

v_np-xp_was_le := vc_there_was_lexent
"""
Cmps NP,Prd-p, be,ex-s,ptsg      
<ex>There was music.
"""
.

v_np-xp_was-sv_le := be_was_subjnct_lex_entry & be_th_cop_pos
"""
Cmps NP,Prd-p, be,ex-s,svsg      
<ex>If there was food, we'd go
"""
.

vc_there_were_lexent := be_were_lex_entry & be_th_cop_pos.

v_np-xp_wre_le := vc_there_were_lexent
"""
Cmps NP,Prd-p, be,ex-s,ptpl      
<ex>There were songs.
"""
.

v_np-xp_wre-sv_le := be_were_subjnct_lex_entry & be_th_cop_pos &
"""
Cmps NP,Prd-p, be,ex-s,svpl      
<ex>If there were ice, we'd go
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

v_np-xp_was-pl_le := be_were_lex_entry & be_th_cop_pos
"""
Cmps NP,Prd-p, be,ex-s ispl      
<ex>There is music and food.
"""
.

v_np-xp_is-cx_le := be_pres_lex_entry & be_th_cop_pos & contracted_aux_word
"""
Cmps NP,Prd-p, be,ex-s,prsg,cntr 
<ex>There's music.
"""
.

v_np-xp_is-n_le := be_is_neg_contr_lex_entry & be_th_cop_neg
"""
Cmps NP,Prd-p, be,ex-s,prsg,n-cr 
<ex>There isn't music.
"""
.

v_np-xp_is-n-niv_le := be_is_neg_contr_noinv_lex_entry & be_th_cop_neg
"""
Cmps NP,Prd-p, be,ex-s,prsg,n,nv 
<ex>There's not any music.
"""
.

v_np-xp_are-n_le := be_are_neg_contr_lex_entry & be_th_cop_neg
"""
Cmps NP,Prd-p, be,ex-s,prpl,n-cr 
<ex>There aren't songs.
"""
.

v_np-xp_was-n_le := be_was_neg_contr_lex_entry & be_th_cop_neg
"""
Cmps NP,Prd-p, be,ex-s,ptsg,n-cr 
<ex>There wasn't music.
"""
.

v_np-xp_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & be_th_cop_neg
"""
Cmps NP,Prd-p, be,ex-s,sbsg,n-cr 
<ex>If there wasn't C, we'd go
"""
.

v_np-xp_wre-n_le := be_were_neg_contr_lex_entry & be_th_cop_neg
"""
Cmps NP,Prd-p, be,ex-s,ptpl,n-cr 
<ex>There weren't any songs.
"""
.

v_np-xp_wre-n-sv_le := be_were_subjnct_neg_contr_lex_entry & 
                             be_th_cop_neg &
"""
Cmps NP,Prd-p, be,ex-s,sbpl,n-cr 
<ex>If there weren't C, B'd go
"""
  [ SYNSEM.LOCAL.AGR.PNG png & [ PN 3s ] ].

; *** It-cleft Copula BE ***

be_it_cop := be_verb &
  [ SYNSEM basic_itcleft_verb_synsem &
           [ LOCAL [ CAT.VAL [ SUBJ.FIRST.LOCAL.CAT nomp_cat_min,
			       COMPS < [ LOCAL.CONT.HOOK [ LTOP #ltop,
							   INDEX #nhind ] ],
				       [ LOCAL.CONT.HOOK.INDEX #vind ] > ],
		     CONT [ ICONS <! focus & [ IARG1 #vind,
					       IARG2 #nhind ] !> ] ],
	     LKEYS [ KEYREL.LBL #ltop,
		     --+ARGIND it-ind ] ] ].

be_it_cop_pos := be_it_cop &
  [ SYNSEM [ LOCAL.CONT [ HOOK.LTOP #ltop,
			  RELS <! !>,
			  HCONS <! !> ],
	     LKEYS.KEYREL.LBL #ltop ] ].

be_it_cop_neg := be_it_cop &
  [ SYNSEM [ LOCAL.CONT [ RELS <! #alt2keyrel !>,
			  HCONS <! qeq !> ],
	     LKEYS.ALT2KEYREL #alt2keyrel ] ].

;; non-scopal
v_np-rc_be_lexent := be_be_lex_entry & be_it_cop_pos &
  [ SYNSEM itcleft_nonscopal_verb_synsem &
	   [ LOCAL.CAT.HEAD.VFORM bse_only ] ].

;; scopal
v_np-rc_be-scop_lexent := be_be_lex_entry & be_it_cop_pos &
  [ SYNSEM itcleft_scopal_verb_synsem &
	   [ LOCAL.CAT.HEAD.VFORM bse_only ] ].

v_np-rc_be_le := v_np-rc_be_lexent
"""
Cmps NP,Relcl, be,ex-s,bse, nonscopal
<ex>It will be C who wins.
"""
.

v_np-rc_be-scop_le := v_np-rc_be-scop_lexent
"""
Cmps NP,Relcl, be,ex-s,bse, scopal
<ex>It will be becuase Kim arrived that we left.
"""
.

v_np-rc_being_le := be_being_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,prp, nonscopal
<ex>It being C who won, D lost
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem &
	   [ LOCAL.CAT.HEAD [ PRD -,
			      TAM.ASPECT.PROGR - ] ] ].

v_np-rc_being-scop_le := be_being_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,prp, scopal
<ex>It being because we arrived that Kim left, D lost
"""
  [ SYNSEM itcleft_scopal_verb_synsem &
	   [ LOCAL.CAT.HEAD [ PRD -,
			      TAM.ASPECT.PROGR - ] ] ].

v_np-rc_been_le := be_been_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,psp, nonscopal
<ex>It has been C who wins.
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_been-scop_le := be_been_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,psp       
<ex>It has been because Kim arrived that we left.
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

v_np-rc_is_le := be_is_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,prsg, nonscopal
<ex>It is C who wins.
"""
  [ INFLECTD +,
    SYNSEM itcleft_nonscopal_verb_synsem ].
    
v_np-rc_is-scop_le := be_is_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,prsg, scopal
<ex>It is because Kim arrived that we left.
"""
  [ INFLECTD +,
    SYNSEM itcleft_scopal_verb_synsem ].
    
v_np-rc_was_le := be_was_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,ptsg, nonscopal
<ex>It was C who won.
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_was-scop_le := be_was_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,ptsg, scopal
<ex>It was because Kim arrived that we left.
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

v_np-rc_was-sv_le := be_was_subjnct_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,sbsg, nonscopal
<ex>If it was C who is, B'd go
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_was-sv-scop_le := be_was_subjnct_lex_entry & be_it_cop_pos &
"""
Cmps NP,Relcl, be,ex-s,sbsg, scopal
<ex>If it was because Kim arrived that we left, B'd go
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

v_np-rc_is-cx_le := be_pres_lex_entry & be_it_cop_pos & contracted_aux_word &
"""
Cmps NP,Relcl, be,ex-s,pr,cntr, nonscopal
<ex>It's C who wins.
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_is-cx-scop_le := be_pres_lex_entry & be_it_cop_pos &
			 contracted_aux_word &
"""
Cmps NP,Relcl, be,ex-s,pr,cntr, scopal
<ex>It's because Kim arrived that we left.
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

v_np-rc_is-n_le := be_is_neg_contr_lex_entry & be_it_cop_neg &
"""
Cmps NP,Relcl, be,ex-s,pr,n-cr, nonscopal
<ex>It isn't C who wins.
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_is-n-scop_le := be_is_neg_contr_lex_entry & be_it_cop_neg &
"""
Cmps NP,Relcl, be,ex-s,pr,n-cr, scopal
<ex>It isn't because Kim arrived that we left.
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

v_np-rc_was-n_le := be_was_neg_contr_lex_entry & be_it_cop_neg &
"""
Cmps NP,Relcl, be,ex-s,pt,n-cr, nonscopal
<ex>It wasn't C who won.
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_was-n-scop_le := be_was_neg_contr_lex_entry & be_it_cop_neg &
"""
Cmps NP,Relcl, be,ex-s,pt,n-cr, scopal
<ex>It wasn't because Kim arrived that we left.
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

v_np-rc_was-n-sv_le := be_was_subjnct_neg_contr_lex_entry & be_it_cop_neg &
"""
Cmps NP,Relcl, be,ex-s,sbsg,n-cr, nonscopal
<ex>If it wasn't C who is, B'd
"""
  [ SYNSEM itcleft_nonscopal_verb_synsem ].

v_np-rc_was-n-sv-scop_le := be_was_subjnct_neg_contr_lex_entry & be_it_cop_neg &
"""
Cmps NP,Relcl, be,ex-s,sbsg,n-cr, scopal
<ex>If it wasn't because Kim arrived that we left, B would leave.
"""
  [ SYNSEM itcleft_scopal_verb_synsem ].

;; do-be copula
;;
be_do_verb_synsem := aux_verb & basic_two_arg &
  [ LOCAL [ CAT [ HEAD [ MINORS [ MIN _be_v_do_rel,
				  ALTMIN nonpass_rel ],
			 INV - ],
                  VAL [ SUBJ < [ LOCAL [ CAT np_cat_nom,
					 CONT.HOOK [ INDEX #id1ind &
							   [ SORT do-event,
							     IFORM #iform ],
						     XARG #xarg ] ],
                                 NONLOC non-local_none,
				 LEX - ] >,
                        COMPS < expressed_synsem &
				[ LOCAL [ CAT vp_cat &
					  [ HEAD [ MINORS.MIN v_event_rel,
						   VFORM fin_or_bse_or_part &
							      #iform ],
					    VAL.SUBJ < synsem &
						       [ LOCAL.CAT.HEAD 
							       basic_noun ] > ],
					  AGR.PNG.PN #pn,
					  CONT.HOOK [ LTOP #vltop,
						      INDEX #id2ind,
						      XARG #xarg & 
							   [ PNG.PN #pn ] ] ],
				  --SIND #id2ind,
				  NONLOC non-local_none,
				  OPT - ] > ] ],
            CONT [ HOOK [ LTOP #ltop,
			  INDEX #event,
			  XARG #id1ind ],
		   RELS <! #keyrel !>,
		   HCONS <! qeq & [ HARG #arg2,
				    LARG #vltop ] !>,
		   ICONS <! !> ] ],
    LEX +,
    LKEYS [ KEYREL arg12_relation & #keyrel &
                 [ LBL #ltop,
		   PRED _be_v_do_rel,
		   ARG0 #event & non_conj_event,
		   ARG1 #id1ind,
                   ARG2 #arg2 ],
	    --+COMPKEY _do_v_be_rel ] ].

be_do_verb_lexent := be_verb & 
  [ SYNSEM be_do_verb_synsem ].

v_vp_do-be_le := be_be_lex_entry & be_do_verb_lexent &
"""
Cmps: base VP, do-be only
<ex>What we'll do will be hire a manager.
"""
  [ SYNSEM.LOCAL.CAT.HEAD.VFORM bse_only ].

v_vp_do-been_le := be_been_lex_entry & be_do_verb_lexent
"""
Cmps: base VP, do-be only
<ex>What he's done has been hire a manager.
"""
.

v_vp_do-is_le := be_is_lex_entry & be_do_verb_lexent &
"""
Cmps: base VP, do-be only
<ex>What he's done is hire a manager.
"""
  [ INFLECTD + ].

v_vp_do-are_le := be_are_lex_entry & be_do_verb_lexent &
"""
Cmps: base VP, do-be only
<ex>The things we do are arrive and leave.
"""
  [ INFLECTD + ].

v_vp_do-was_le := be_was_lex_entry & be_do_verb_lexent
"""
Cmps: base VP, do-be only
<ex>What we did was hire a manager.
"""
.

v_vp_do-wre_le := be_were_lex_entry & be_do_verb_lexent
"""
Cmps: base VP, do-be only
<ex>The things we did were arrive and leave.
"""
.

;; DPF 2018-08-24 - For some reason, PET's flop will not compile this file
;; without the following 99-character line preceded by a semicolon:
;; (and similarly for letypes.tdl but not lextypes.tdl)
;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx