contracted forms in PredEng. It is very important for efficiency that variants are formed at the last possible stage of sentence formation. This compromises the compactness of the source code somewhat.

This commit is contained in:
aarne
2014-03-12 05:53:24 +00:00
parent c1c4d38027
commit 896efb12c8
3 changed files with 39 additions and 28 deletions

View File

@@ -9,6 +9,8 @@ concrete PredEng of Pred =
QuestVP,
RelVP,
UseCl, -- for contracted forms
QuestIComp ---- IComp has no parameters in Eng
]
with
@@ -21,6 +23,7 @@ concrete PredEng of Pred =
lin
PassUseV x a t p v = initPrVerbPhraseV a t p v ** {
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
vc = \\agr => tenseVContracted (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
@@ -28,6 +31,7 @@ lin
AgentPassUseV x a t p v np = initPrVerbPhraseV a t p v ** {
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
v = \\agr => tenseVContracted (a.s ++ t.s ++ p.s) t.t a.a p.p passive agr v ;
inf = \\vt => tenseInfV a.s a.a p.p passive v vt ;
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
adv = appComplCase agentCase np ;
@@ -37,6 +41,7 @@ lin
PredVP x np vp = vp ** {
v = applyVerb vp (agr2vagr np.a) ;
vc = vp.vc ! (agr2vagr np.a) ;
subj = appSubjCase np ;
adj = vp.adj ! np.a ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj
@@ -50,6 +55,7 @@ lin
ipa = ipagr2agr ip.n
in {
v = applyVerb vp (ipagr2vagr ip.n) ;
vc = vp.vc ! (ipagr2vagr ip.n) ;
foc = ip.s ! subjCase ;
focType = FocSubj ;
subj = [] ;
@@ -63,6 +69,9 @@ lin
qforms = qformsVP vp (ipagr2vagr ip.n) ;
} ;
UseCl cl = {s = declCl cl}
| {s = declClContracted cl} ;
RelVP rp vp =
let
cl : Agr -> PrClause = \a ->
@@ -70,6 +79,7 @@ lin
vp ** {
v = applyVerb vp (agr2vagr rpa) ;
vc = vp.vc ! (agr2vagr rpa) ;
subj = rp.s ! subjRPCase a ;
adj = vp.adj ! rpa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj
@@ -92,7 +102,8 @@ lin
QuestIComp a t p icomp np =
let vagr = (agr2vagr np.a) in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
vc = tenseCopulaC (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = np.s ! subjCase ;
foc = icomp.s ;
focType = FocObj ;

View File

@@ -10,28 +10,25 @@ instance PredInstanceEng of PredInterface - [
oper
PrVerbPhrase = BasePrVerbPhrase ** {qforms : VAgr => Str * Str} ;
PrClause = BasePrClause ** {qforms : Str * Str} ;
-- 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
} ;
initPrVerbPhraseVContracted :
{s : Str ; a : Anteriority} -> {s : Str ; t : STense} -> {s : Str ; p : Polarity} -> PrVerb -> PrVerbPhrase =
\a,t,p,v -> initPrVerbPhraseV a t p v ** {
v = \\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 = <[],[]> ;
} ;
@@ -39,6 +36,7 @@ oper
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 ;
@@ -192,7 +190,9 @@ oper
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_Aux 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 ->
@@ -232,7 +232,6 @@ oper
_ => 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>
----slow | <do_Aux vt Neg, [], sta ++ v.s ! VVF VInf>
}
} ;
@@ -261,12 +260,12 @@ oper
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> ;
<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>
---- | <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 ->
@@ -313,8 +312,7 @@ oper
----- 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_AuxC 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
@@ -340,26 +338,28 @@ oper
<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,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, [], []> ;
<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 ;
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 ; -- om she sleeps
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
} ;

View File

@@ -15712,7 +15712,7 @@ lin descent_N = mkN "börd" | mkN "överfall" neutrum ; -- SaldoWN -- comment=15
lin describable_A = mkA "beskrivbar" ;
lin describe_V = mkV "beskriva" "beskrev" "beskrivit" ; -- SaldoWN
lin describe_V2 = mkV2 "beskriva" "beskrev" "beskrivit" | dirV2 (partV (mkV "kallar")"ut") ; -- SaldoWN
lin describe_VS = mkVS (mkV "beskriva" "beskrev" "beskrivit" ; -- SaldoWN -- status=guess, src=wikt
lin describe_VS = mkVS (mkV "beskriva" "beskrev" "beskrivit") ; -- SaldoWN
lin description_N = mkN "slag" neutrum; -- comment=7
lin descriptive_A = mkA "beskrivande" ; -- comment=2
lin descriptivism_N = variants {} ;
@@ -15766,7 +15766,7 @@ lin desire_V2 = mkV2 (mkV "begära") | mkV2 (mkV "åtrå"); -- status=guess, src
lin desirous_A = mkA "lysten" "lystet" ; -- SaldoWN
lin desist_V = mkV "avstå" "avstod" "avstått" ; -- comment=2
lin desk_N = mkN "skolbänk" ; -- SaldoWN
lin desktop_N = mkN "c-p" ; -- status=guess
lin desktop_N = mkN "PC" ;
lin desmid_N = variants {} ;
lin desmond_PN = variants {} ;
lin desolate_A = mkA "öde" ; -- comment=5