gf-3.6: lib/src/experimental/PredInstanceEng.gf
instance PredInstanceEng of PredInterface - [
PrVerbPhrase, PrClause,
initPrVerbPhrase, initPrVerbPhraseV, initPrClause,
useCopula, questCl, linrefPrQCl
] =
open ResEng, (X = ParamX), Prelude in {
----- overrides ----------------
oper
-- add contracted verb forms and forms for question
PrVerbPhrase = BasePrVerbPhrase ** {vc : VAgr => Str * Str * Str ; qforms : VAgr => Str * Str} ;
PrClause = BasePrClause ** {vc : Str * Str * Str ; qforms : Str * Str} ;
initPrVerbPhrase : PrVerbPhrase = initBasePrVerbPhrase ** {
vc : VAgr => Str * Str * Str = \\_ => <[],[],[]> ;
qforms = \\agr => <[],[]> ;
} ;
initPrVerbPhraseV :
{s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase =
\a,t,p,v -> initBasePrVerbPhraseV a t p v ** {
vc = \\agr => tenseVContracted (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ;
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v
} ;
initPrClause : PrClause = initBasePrClause ** {
vc = <[],[],[]> ;
qforms = <[],[]> ;
} ;
useCopula : {s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} ->
PrVerbPhrase =
\a,t,p -> initPrVerbPhrase ** {
v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
vc = \\agr => tenseCopulaC (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
inf = \\vt => tenseInfCopula a.s a.a p.p vt ;
imp = \\n => tenseImpCopula p.s p.p n ;
adV = negAdV p ;
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
questCl : PrQuestionClause -> Str = \cl -> case cl.focType of {
NoFoc => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- does she sleep
FocObj => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- who does she love
FocSubj => cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl -- who loves her
} ;
linrefPrQCl : PrQuestionClause -> Str = \qcl -> questCl qcl ;
---------------------
-- parameters -------
---------------------
oper
Gender = ResEng.Gender ;
Agr = ResEng.Agr ;
Case = ResEng.Case ;
NPCase = ResEng.NPCase ;
VForm = ResEng.VVForm ; ---- VVForm to get contracted aux verbs
VVType = ResEng.VVType ;
SVoice = Voice ;
VAgr = EVAgr ;
VType = EVType ;
param --- have to do this clumsy way because param P and oper P : PType don't unify
EVAgr = VASgP1 | VASgP3 | VAPl ;
EVType = VTAct | VTRefl | VTAux ;
oper
active : SVoice = Act ;
passive : SVoice = Pass ;
defaultVType : VType = VTAct ;
subjCase : NPCase = NCase Nom ;
objCase : NPCase = NPAcc ;
agentCase : ComplCase = "by" ;
ComplCase = Str ; -- preposition
NounPhrase = {s : NPCase => Str ; a : Agr} ;
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ;
noComplCase : ComplCase = [] ;
strComplCase : ComplCase -> Str = \c -> c ;
noObj : Agr => Str = \\_ => [] ;
RPCase = ResEng.RCase ;
subjRPCase : Agr -> RPCase = \a -> RC (fromAgr a).g npNom ;
NAgr = Number ;
IPAgr = Number ;
RPAgr = ResEng.RAgr ;
ICAgr = Unit ;
defaultAgr : Agr = AgP3Sg Neutr ;
-- omitting rich Agr information
agr2vagr : Agr -> VAgr = \a -> case a of {
AgP1 Sg => VASgP1 ;
AgP3Sg _ => VASgP3 ;
_ => VAPl
} ;
agr2aagr : Agr -> AAgr = \a -> a ;
agr2nagr : Agr -> NAgr = \a -> case a of {
AgP1 n => n ;
AgP2 n => n ;
AgP3Sg _ => Sg ;
AgP3Pl => Pl
} ;
agr2icagr : Agr -> ICAgr = \a -> UUnit ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \n -> case n of {
Sg => AgP3Sg Neutr ; ---- gender
Pl => AgP3Pl
} ;
ipagr2vagr : IPAgr -> VAgr = \n -> case n of {
Sg => VASgP3 ;
Pl => VAPl
} ;
rpagr2agr : RPAgr -> Agr -> Agr = \ra,a -> case ra of {
RAg ag => ag ;
RNoAg => a
} ;
--- this is only needed in VPC formation
vagr2agr : VAgr -> Agr = \a -> case a of {
VASgP1 => AgP1 Sg ;
VASgP3 => AgP3Sg Neutr ;
VAPl => AgP3Pl
} ;
vPastPart : PrVerb -> AAgr -> Str = \v,_ -> v.s ! VVF VPPart ;
vPresPart : PrVerb -> AAgr -> Str = \v,_ -> v.s ! VVF VPresPart ;
vvInfinitive : VVType = VVInf ;
isRefl : PrVerb -> Bool = \v -> case v.vtype of {VTRefl => True ; _ => False} ;
-----------------------
-- concrete opers
-----------------------
oper
reflPron : Agr -> Str = \a -> ResEng.reflPron ! a ;
infVP : VVType -> Agr -> PrVerbPhrase -> Str = \vt, a,vp ->
let
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} ;
in
vp.adV ++ vp.inf ! vt ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
impVP : Number -> PrVerbPhrase -> Str = \n,vp ->
let
a = AgP2 n
in
vp.adV ++ vp.imp ! n ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a ++ vp.adv ++ vp.ext ;
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str =
\sta,t,a,p,agr,v ->
let
verb = tenseActV sta t a Neg agr v ;
averb = tenseActV sta t a p agr v
in case <v.vtype, t, a> of {
<VTAct|VTRefl, Pres|Past, Simul> => case p of {
Pos => < verb.p1, verb.p3> ; -- does , sleep
Neg => < verb.p1, verb.p2> -- does , not sleep ---- TODO: doesn't , sleep
} ;
_ => <averb.p1, averb.p2>
} ;
qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
\sta,t,a,p,agr ->
let verb = be_AuxL sta t a p agr
in <verb.p1, verb.p2> ; -- is , not ---- TODO isn't ,
tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \s,t,a,p,agr ->
be_AuxL s t a p agr ;
tenseCopulaC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \s,t,a,p,agr ->
be_AuxC s t a p agr ;
tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str = \s,a,p,vt ->
tenseInfV s a p Act be_V vt ;
tenseImpCopula : Str -> Polarity -> ImpType -> Str = \s,p,n ->
imperativeV s p n be_V ;
tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str =
\sta,t,a,p,o,agr,v ->
case o of {
Act => tenseActV sta t a p agr v ;
Pass => tensePassV sta t a p agr v
} ;
---- leaving out these variants makes compilation time go down from 900ms to 300ms.
---- parsing time of "she sleeps" goes down from 300ms to 60ms. 4/2/2014
tenseVContracted : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str =
\sta,t,a,p,o,agr,v ->
case o of {
Act => tenseActVContracted sta t a p agr v ;
Pass => tensePassVContracted sta t a p agr v
} ;
tenseActV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : ResEng.VForm = case <t,agr> of {
<Pres,VASgP3> => VPres ;
<Past|Cond,_ > => VPast ;
_ => VInf
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.vtype of {
VTAux => case t of {
Pres => <sta ++ v.s ! VVF VPres, not_Str p, []> ; -- can I/she/we
_ => <sta ++ v.s ! VVF vt, not_Str p, []> -- could ...
} ;
_ => case p of {
Pos => <[], sta ++ v.s ! VVF vt, []> ; -- this is the deviating case
Neg => <do_Aux vt Pos, not_Str p, sta ++ v.s ! VVF VInf>
}
} ;
<Pres|Past, Anter> => <have_Aux vt Pos, not_Str p, sta ++ v.s ! VVF VPPart> ;
<Fut|Cond, Simul> => <will_Aux vt Pos, not_Str p, sta ++ v.s ! VVF VInf> ;
<Fut|Cond, Anter> => <will_Aux vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.s ! VVF VPPart>
} ;
tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : ResEng.VForm * VVForm = case <t,agr> of {
<Pres,VASgP3> => <VPres, VVPresNeg> ;
<Past|Cond,_ > => <VPast, VVPastNeg> ;
_ => <VInf, VVF VInf>
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.vtype of {
VTAux => case p of {
Pos => <sta ++ v.s ! VVF vt.p1, [], []> ;
Neg => <sta ++ v.s ! vt.p2, [], []>
} ;
_ => case p of {
Pos => <[], sta ++ v.s ! VVF vt.p1, []> ; -- this is the deviating case
Neg => <do_Aux vt.p1 p, [], sta ++ v.s ! VVF VInf>
}
} ;
<Pres|Past, Anter> => <have_AuxC vt.p1 p, [], sta ++ v.s ! VVF VPPart> ;
---- | <have_AuxC vt.p1 Pos, not_Str p, sta ++ v.s ! VVF VPPart> ;
<Fut|Cond, Simul> => <will_AuxC vt.p1 p, [], sta ++ v.s ! VVF VInf> ;
---- | <will_AuxC vt.p1 Pos, not_Str p, sta ++ v.s ! VVF VInf> ;
<Fut|Cond, Anter> => <will_AuxC vt.p1 p, have_Aux VInf Pos, sta ++ v.s ! VVF VPPart>
---- | <will_AuxC vt.p1 Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.s ! VVF VPPart>
} ;
tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxL sta t a p agr ;
done = v.s ! VVF VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxC sta t a p agr ;
done = v.s ! VVF VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,p,o,v,vt ->
let
not = case p of {Pos => [] ; Neg => "not"} ;
in
case vt of {
VVInf =>
case a of {
Simul => not ++ "to" ++ sa ++ v.s ! VVF VInf ; -- (she wants) (not) to sleep
Anter => not ++ "to" ++ have_Aux VInf Pos ++ sa ++ v.s ! VVF VPPart -- (she wants) (not) to have slept
} ;
VVAux =>
case a of {
Simul => not ++ sa ++ v.s ! VVF VInf ; -- (she must) (not) sleep
Anter => not ++ have_Aux VInf Pos ++ sa ++ v.s ! VVF VPPart -- (she must) (not) have slept
} ;
VVPresPart =>
case a of {
Simul => not ++ sa ++ v.s ! VVF VPresPart ; -- (she starts) (not) sleeping
Anter => not ++ "having" ++ sa ++ v.s ! VVF VPPart -- (she starts) (not) having slept
}
} ;
imperativeV : Str -> Polarity -> ImpType -> PrVerb -> Str = \s,p,it,v ->
s ++ case p of {
Pos => v.s ! VVF VInf ;
Neg => ("do not" | "don't") ++ v.s ! VVF VInf
} ;
----- dangerous variants for PMCFG generation - keep apart as long as possible
be_Aux : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
be_AuxL sta t a p agr ;
be_AuxL : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
let
beV = tenseActV sta t a p agr be_V
in
case <t,a,p,agr> of {
<Pres,Simul,Pos,VASgP3> => <"is" ++ sta, [], []> ;
<Pres,Simul,Pos,VASgP1> => <"am" ++ sta, [], []> ;
<Pres,Simul,Pos,VAPl> => <"are" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP3> => <"is" ++ sta, "not", []> ;
<Pres,Simul,Neg,VASgP1> => <"am" ++ sta, "not", []> ;
<Pres,Simul,Neg,VAPl> => <"are" ++ sta, "not", []> ;
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,VAPl> => <"were" ++ sta, "not", []> ;
<Past,Simul,Neg,_> => <"was" ++ sta, "not", []> ;
_ => beV
} ;
be_AuxC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
let
beV = tenseActVContracted sta t a p agr be_V
in
case <t,a,p,agr> of {
<Pres,Simul,Pos,VASgP3> => <Predef.BIND ++ "'s" ++ sta, [], []> ;
<Pres,Simul,Pos,VASgP1> => <Predef.BIND ++ "'m" ++ sta, [], []> ;
<Pres,Simul,Pos,VAPl> => <Predef.BIND ++ "'re" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP3> => ---- <Predef.BIND ++ "'s" ++ sta, "not", []>
<"isn't" ++ sta, [], []> ;
<Pres,Simul,Neg,VASgP1> => <Predef.BIND ++ "'m" ++ sta, "not", []> ;
<Pres,Simul,Neg,VAPl> => ---- <Predef.BIND ++ "'re" ++ sta, "not", []>
<"aren't" ++ sta, [], []> ;
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,VAPl> => <"weren't" ++ sta, [], []> ;
<Past,Simul,Neg,_> => <"wasn't" ++ sta, [], []> ;
_ => beV
} ;
declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
declSubordCl : PrClause -> Str = declCl ;
declInvCl : PrClause -> Str = declCl ;
declClContracted : PrClause -> Str = \cl -> cl.subj ++ cl.vc.p1 ++ cl.adV ++ cl.vc.p2 ++ restCl cl ; -- contracted forms
questSubordCl : PrQuestionClause -> Str = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ restCl cl
in case cl.focType of {
NoFoc => "if" ++ cl.foc ++ rest ; -- if she sleeps
FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps
FocSubj => cl.foc ++ rest -- who loves her
} ;
--- only needed in Eng because of do questions
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str ;
qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str ;
qformsVP : PrVerbPhrase -> VAgr -> Str * Str
= \vp,vagr -> vp.qforms ! vagr ;
that_Compl : Str = "that" | [] ;
-- this part is usually the same in all reconfigurations
restCl : PrClause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ;
addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** {
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
} ;
addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** {
ext = ext ;
} ;
oper
be_V : PrVerb = {
s = table {
VVF VInf => "be" ;
VVF VPres => "is" ;
VVF VPast => "was" ;
VVF VPPart => "been" ;
VVF VPresPart => "being" ;
VVPresNeg => "isn't" ;
VVPastNeg => "wasn't"
} ;
p,c1,c2 = [] ; vtype = VTAux ; vvtype = VVInf ; isSubjectControl = False
} ;
negAdV : {s : Str ; p : Polarity} -> Str = \p -> p.s ;
oper
---- have to split the tables to two to get reasonable PMCFG generation
will_Aux : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => varAux "will" "ll" ;
<VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => varAux "would" "d" ;
<VPast|_ , Neg> => "wouldn't"
} ;
will_AuxC : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => varAuxC "will" "ll" ;
<VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => varAuxC "would" "d" ;
<VPast|_ , Neg> => "wouldn't"
} ;
have_Aux : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ;
<VPres, Pos> => varAux "has" "s" ;
<VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => varAux "had" "d" ;
<VPast|_ , Neg> => "hadn't"
} ;
have_AuxC : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => varAuxC "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ;
<VPres, Pos> => varAuxC "has" "s" ;
<VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => varAuxC "had" "d" ;
<VPast|_ , Neg> => "hadn't"
} ;
do_Aux : ResEng.VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => "do" ;
<VInf, Neg> => "don't" ;
<VPres, Pos> => "does" ;
<VPres, Neg> => "doesn't" ;
<VPast|_ , Pos> => "did" ;
<VPast|_ , Neg> => "didn't"
} ;
varAux : Str -> Str -> Str = \long,short -> long ; ----| Predef.BIND ++ ("'" + short) ;
varAuxC : Str -> Str -> Str = \long,short -> Predef.BIND ++ ("'" + short) ;
not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ;
}