Files
gf-core/lib/src/english/ExtraEng.gf

253 lines
6.8 KiB
Plaintext

concrete ExtraEng of ExtraEngAbs = CatEng **
open ResEng, Coordination, Prelude, MorphoEng, ParadigmsEng in {
lin
GenNP np = {s = \\_,_ => np.s ! npGen ; sp = \\_,_,_ => np.s ! npGen} ;
GenIP ip = {s = \\_ => ip.s ! NCase Gen} ;
GenRP nu cn = {
s = \\c => "whose" ++ nu.s ! Nom ++
case c of {
RC _ (NCase Gen) => cn.s ! nu.n ! Gen ;
_ => cn.s ! nu.n ! Nom
} ;
a = RAg (agrP3 nu.n)
} ;
StrandRelSlash rp slash = {
s = \\t,a,p,ag =>
rp.s ! RC (fromAgr ag).g NPAcc ++ slash.s ! t ! a ! p ! oDir ++ slash.c2 ;
c = NPAcc
} ;
EmptyRelSlash slash = {
s = \\t,a,p,_ => slash.s ! t ! a ! p ! oDir ++ slash.c2 ;
c = NPAcc
} ;
StrandQuestSlash ip slash =
{s = \\t,a,b,q =>
(mkQuestion (ss (ip.s ! NPAcc)) slash).s ! t ! a ! b ! q ++ slash.c2
};
lincat
VPI = {s : VVType => Agr => Str} ;
[VPI] = {s1,s2 : VVType => Agr => Str} ;
lin
BaseVPI = twoTable2 VVType Agr ;
ConsVPI = consrTable2 VVType Agr comma ;
MkVPI vp = {
s = table {
VVAux => \\a => vp.ad ! a ++ vp.inf ++ vp.p ++ vp.s2 ! a;
VVInf => \\a => "to" ++ vp.ad ! a ++ vp.inf ++ vp.p ++ vp.s2 ! a;
VVPresPart => \\a => vp.ad ! a ++ vp.prp ++ vp.p ++ vp.s2 ! a
}
} ;
ConjVPI = conjunctDistrTable2 VVType Agr ;
ComplVPIVV vv vpi =
insertObj (\\a => vpi.s ! vv.typ ! a) (predVV vv) ;
lin
that_RP =
{ s = table {
RC _ (NCase Gen) => "whose" ;
RC _ _ => "that" ;
_ => "that" ---- "in that" ?
-- RPrep Neutr => "which" ;
-- RPrep _ => "whom"
} ;
a = RNoAg
} ;
each_Det = mkDeterminer Sg "each" ;
any_Quant = mkQuant "any" "any" ;
-- for VP conjunction
lincat
VPS = {s : Agr => Str} ;
[VPS] = {s1,s2 : Agr => Str} ;
lin
BaseVPS = twoTable Agr ;
ConsVPS = consrTable Agr comma ;
PredVPS np vpi = {s = np.s ! npNom ++ vpi.s ! np.a} ;
MkVPS t p vp = {
s = \\a =>
let
verb = vp.s ! t.t ! t.a ! p.p ! oDir ! a ;
verbf = verb.aux ++ verb.adv ++ verb.fin ++ verb.inf ;
in t.s ++ p.s ++ vp.ad ! a ++ verbf ++ vp.p ++ vp.s2 ! a ++ vp.ext
} ;
ConjVPS = conjunctDistrTable Agr ;
ICompAP ap = {s = "how" ++ ap.s ! agrP3 Sg} ; ---- IComp should have agr!
IAdvAdv adv = {s = "how" ++ adv.s} ;
PartVP vp = {
s = \\a => vp.ad ! a ++ vp.prp ++ vp.s2 ! a ++ vp.ext ;
isPre = vp.isSimple -- depends on whether there are complements
} ;
EmbedPresPart vp = {s = infVP VVPresPart vp Simul CPos (agrP3 Sg)} ; --- agr
UttVPShort vp = {s = infVP VVAux vp Simul CPos (agrP3 Sg)} ;
do_VV = {
s = table {
VVF VInf => ["do"] ;
VVF VPres => "does" ;
VVF VPPart => ["done"] ; ----
VVF VPresPart => ["doing"] ;
VVF VPast => ["did"] ; --# notpresent
VVPastNeg => ["didn't"] ; --# notpresent
VVPresNeg => "doesn't"
} ;
p = [] ;
typ = VVAux
} ;
may_VV = lin VV {
s = table {
VVF VInf => ["be allowed to"] ;
VVF VPres => "may" ;
VVF VPPart => ["been allowed to"] ;
VVF VPresPart => ["being allowed to"] ;
VVF VPast => "might" ; --# notpresent
VVPastNeg => "mightn't" ; --# notpresent
VVPresNeg => "may not"
} ;
p = [] ;
typ = VVAux
} ;
shall_VV = lin VV {
s = table {
VVF VInf => ["be obliged to"] ; ---
VVF VPres => "shall" ;
VVF VPPart => ["been obliged to"] ;
VVF VPresPart => ["being obliged to"] ;
VVF VPast => "should" ; --# notpresent
VVPastNeg => "shouldn't" ; --# notpresent
VVPresNeg => "shall not" --- shan't
} ;
p = [] ;
typ = VVAux
} ;
NominalizeVPSlashNP vpslash np =
let vp : ResEng.VP = insertObjPre (\\_ => vpslash.c2 ++ np.s ! NPAcc) vpslash ;
a = AgP3Sg Neutr
in
lin NP {s = \\_ => vp.ad ! a ++ vp.prp ++ vp.s2 ! a ; a = a} ;
lin
UncNeg = {s = [] ; p = CNeg False} ;
oper passVPSlash : VPSlash -> Str -> ResEng.VP =
\vps,ag ->
let
be = predAux auxBe ;
ppt = vps.ptp
in {
s = be.s ;
p = [] ;
prp = be.prp ;
ptp = be.ptp ;
inf = be.inf ;
ad = \\_ => [] ;
s2 = \\a => vps.ad ! a ++ ppt ++ vps.p ++ ag ++ vps.s2 ! a ++ vps.c2 ; ---- place of agent
isSimple = False ;
ext = vps.ext
} ;
lin
PassVPSlash vps = passVPSlash vps [] ;
PassAgentVPSlash vps np = passVPSlash vps ("by" ++ np.s ! NPAcc) ;
--- AR 7/3/2013
ComplSlashPartLast vps np = case vps.gapInMiddle of {
_ => insertObjPartLast (\\_ => vps.c2 ++ np.s ! NPAcc) vps ---
} ;
--- AR 22/5/2013
ExistsNP np =
mkClause "there" (agrP3 (fromAgr np.a).n)
(insertObj (\\_ => np.s ! NPAcc) (predV (regV "exist"))) ;
PurposeVP vp = {s = infVP VVInf vp Simul CPos (agrP3 Sg)} ; --- agr
ComplBareVS v s = insertExtra s.s (predV v) ;
SlashBareV2S v s = insertExtrac s.s (predVc v) ;
ContractedUseCl t p cl = {
s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! ODir True
} ;
------------
--- obsolete: use UncNeg : Pol
UncNegCl t p cl = {
s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! unc p.p ! oDir
} ;
UncNegQCl t p cl = {
s = \\q => t.s ++ p.s ++ cl.s ! t.t ! t.a ! unc p.p ! q
} ;
UncNegRCl t p cl = {
s = \\r => t.s ++ p.s ++ cl.s ! t.t ! t.a ! unc p.p ! r ;
c = cl.c
} ;
UncNegImpSg p imp = {s = p.s ++ imp.s ! unc p.p ! ImpF Sg False} ;
UncNegImpPl p imp = {s = p.s ++ imp.s ! unc p.p ! ImpF Pl False} ;
CompoundCN a b = {s = \\n,c => a.s ! Sg ! Nom ++ b.s ! n ! c ; g = b.g} ;
FrontExtPredVP np vp = {
s = \\t,a,b,o =>
let
subj = np.s ! npNom ;
agr = np.a ;
verb = vp.s ! t ! a ! b ! o ! agr ;
compl = vp.s2 ! agr
in
case o of {
ODir _ => vp.ext ++ frontComma ++ subj ++ verb.aux ++ verb.adv ++ vp.ad ! agr ++ verb.fin ++ verb.inf ++ vp.p ++ compl ;
OQuest => verb.aux ++ subj ++ verb.adv ++ vp.ad ! agr ++ verb.fin ++ verb.inf ++ vp.p ++ compl ++ vp.ext
}
} ;
InvFrontExtPredVP np vp = {
s = \\t,a,b,o =>
let
subj = np.s ! npNom ;
agr = np.a ;
verb = vp.s ! t ! a ! b ! o ! agr ;
compl = vp.s2 ! agr
in
case o of {
ODir _ => vp.ext ++ verb.aux ++ verb.adv ++ vp.ad ! agr ++ verb.fin ++ subj ++ verb.inf ++ vp.p ++ compl ;
OQuest => verb.aux ++ subj ++ verb.adv ++ vp.ad ! agr ++ verb.fin ++ verb.inf ++ vp.p ++ compl ++ vp.ext
}
} ;
oper
unc : CPolarity -> CPolarity = \x -> case x of {
CNeg _ => CNeg False ;
_ => x
} ;
-------
}