msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

predication-based TransSwe delivering the first sentences

Browse Source
This commit is contained in:
aarne
2014-02-05 20:03:51 +00:00
parent b11977a152
commit 935e8ee4ff
3 changed files with 76 additions and 244 deletions
Download Patch File Download Diff File Expand all files Collapse all files

301
lib/src/experimental/PredSwe.gf
View File

@@ -1,4 +1,4 @@
concrete PredSwe of Pred = CatSwe - [Pol] ** open ResSwe, CommonScand, TenseX, ParamX, Prelude in {
concrete PredSwe of Pred = CatSwe - [Tense] ** open ResSwe, (P = ParadigmsSwe), CommonScand, ParamX, Prelude in {
---------------------
-- parameters -------
@@ -92,15 +92,13 @@ oper
-- lincats
-------------------------------------
lincat
{-
-- standard general
Tense = {s : Str ; t : STense} ;
Ant = {s : Str ; a : Anteriority} ;
Pol = {s : Str ; p : Polarity} ;
Utt = {s : Str} ;
IAdv = {s : Str} ;
-}
Pol = {s : Str ; p : Polarity} ;
Tense = {s : Str ; t : ParamX.Tense} ;
-- Ant = {s : Str ; a : Anteriority} ;
-- Pol = {s : Str ; p : Polarity} ;
-- Utt = {s : Str} ;
-- IAdv = {s : Str} ;
-- predication-specific
Arg = {s : Str} ;
@@ -186,7 +184,6 @@ lincat
Conj = {s1,s2 : Str ; n : Number} ;
-}
{- -----------------------------------
-- reference linearizations for chunking
@@ -203,9 +200,9 @@ linref
PrCl = \cl -> declCl cl ;
---- PrQCl = \qcl -> questCl (lin PrQCl qcl) ;
PrAdv = \adv -> adv.c1 ++ adv.s ;
PrAP = \ap -> ap.s ! UUnit ++ ap.obj1 ! defaultAgr ;
PrAP = \ap -> ap.s ! agr2aagr defaultAgr ++ ap.obj1 ! defaultAgr ;
PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ;
----------------------------
--- linearization rules ----
----------------------------
@@ -235,15 +232,15 @@ lin
c2 = v.c2 ;
part = v.p ;
adj = noObj ;
obj1 = <case v.isRefl of {True => \\a => reflPron ! a ; False => \\_ => []}, defaultAgr> ; ---- not used, just default value
obj1 = <case v.isRefl of {True => \\a => reflPron a ; False => \\_ => []}, defaultAgr> ; ---- not used, just default value
obj2 = <noObj, v.isSubjectControl> ;
adV = negAdV p ; --- just p.s in Swe
adv = [] ;
ext = [] ;
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
qforms = \\_ => <[],[]> ; ---- not needed in Swe
} ;
{- -----------------------------------
PassUseV a t p _ v = {
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ;
inf = tenseInfV a.s a.a p.p Pass v ;
@@ -289,6 +286,10 @@ lin
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ;
---------------------- -}
SlashV2 x vp np = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => np.s ! objCase, np.a> -- np.a for object control
} ;
@@ -299,6 +300,8 @@ lin
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
{---------------
ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm
ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
@@ -322,6 +325,8 @@ lin
ReflVP2 x vp = vp ** {
obj2 : (Agr => Str) * Bool = <\\a => reflPron ! a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
} ;
-} ----------------------
PredVP x np vp = vp ** {
v = vp.v ! agr2vagr np.a ;
@@ -348,9 +353,12 @@ lin
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: why does she love us
QuestVP x ip vp = let ipa = ipagr2agr ip.n in
QuestVP x ip vp =
let
ipa = ipagr2agr {g = ip.g ; n = ip.n} ; ipv = ipagr2vagr {g = ip.g ; n = ip.n}
in
vp ** {
v = vp.v ! ipagr2vagr ip.n ;
v = vp.v ! ipv ;
foc = ip.s ! subjCase ; -- who (loves her)
focType = FocSubj ;
subj = [] ;
@@ -358,7 +366,7 @@ lin
obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ipa ; False => vp.obj1.p2}) ; ---- appComplCase
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
qforms = vp.qforms ! ipagr2vagr ip.n ;
qforms = vp.qforms ! ipagr2vagr ipa ;
} ;
QuestSlash x ip cl =
@@ -385,7 +393,7 @@ lin
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = noComplCase ;
} ;
- }
-}
UseCl cl = {s = declCl cl} ;
UseQCl cl = {s = questCl cl} ;
@@ -405,6 +413,7 @@ lin
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
} ;
{- -----------------------------
PresPartAP x v = {
s = \\a => v.v ! vPresPart a ;
@@ -483,175 +492,64 @@ lin
-}
oper
infVP : Agr -> PrVerbPhrase -> Str = \a,vp ->
let
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
in
vp.adV ++ vp.inf.p1 ++ vp.inf.p2 ++ vp.part ++
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> 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.isAux, t, a> of {
<False,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>
} ;
qformsBe : 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 ,
tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> PrV -> 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
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 -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : VForm = case <t,agr> of {
<Pres,VASgP3> => VPres ;
<Past|Cond,_ > => VPast ;
_ => VInf
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.isAux of {
True => <sta ++ v.v ! vt, [], []> ;
False => case p of {
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
Neg => <do_Aux vt Pos, not_Str p, sta ++ v.v ! VInf>
}
} ;
------------------
--- opers --------
------------------
<Pres|Past, Anter> => <have_Aux vt Pos, not_Str p, sta ++ v.v ! VPPart> ;
<Fut|Cond, Simul> => <will_Aux vt Pos, not_Str p, sta ++ v.v ! VInf> ;
<Fut|Cond, Anter> => <will_Aux vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPPart>
} ;
tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v ->
let vt : VForm = case <t,agr> of {
<Pres,VASgP3> => VPres ;
<Past|Cond,_ > => VPast ;
_ => VInf
} ;
in
case <t,a> of {
<Pres|Past, Simul> =>
case v.isAux of {
True => <sta ++ v.v ! vt, [], []> ;
False => case p of {
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
Neg => <do_Aux vt p, [], sta ++ v.v ! VInf>
}
} ;
<Pres|Past, Anter> => <have_AuxC vt p, [], sta ++ v.v ! VPPart>
| <have_AuxC vt Pos, not_Str p, sta ++ v.v ! VPPart> ;
<Fut|Cond, Simul> => <will_AuxC vt p, [], sta ++ v.v ! VInf>
| <will_AuxC vt Pos, not_Str p, sta ++ v.v ! VInf> ;
<Fut|Cond, Anter> => <will_AuxC vt p, have_Aux VInf Pos, sta ++ v.v ! VPPart>
| <will_AuxC vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPPart>
} ;
tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxL sta t a p agr ;
done = v.v ! VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrV -> Str * Str * Str = \sta,t,a,p,agr,v ->
let
be = be_AuxC sta t a p agr ;
done = v.v ! VPPart
in
<be.p1, be.p2, be.p3 ++ done> ;
tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrV -> Str * Str = \sa,a,p,o,v ->
case a of {
Simul => <[], sa ++ v.v ! VInf> ; -- (she wants to) sleep
Anter => <have_Aux VInf Pos, sa ++ v.v ! VPPart> -- (she wants to) have slept
} ;
----- 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 : 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
} ;
oper
declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
declSubordCl : PrClause -> Str = declCl ;
declInvCl : PrClause -> Str = declCl ;
declSubordCl : PrClause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
declInvCl : PrClause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
questCl : PrQCl -> 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
} ;
questCl : PrQCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
questSubordCl : PrQCl -> Str = \cl ->
let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ restCl cl
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
FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps
FocSubj => cl.foc ++ rest -- who loves her
NoFoc => "om" ++ cl.foc ++ rest ; -- om hon sover
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne
} ;
that_Compl : Str = "that" | [] ;
that_Compl : Str = "att" | [] ;
-- 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 ++ cl.c3 ;
negAdV : PredSwe.Pol -> Str = \p -> p.s ++ case p.p of {Pos => [] ; Neg => "inte"} ;
tenseV : Str -> ParamX.Tense -> Anteriority -> Polarity -> Voice -> VAgr -> PrV -> Str * Str * Str = --- Polarity, VAgr not needed in Swe
\sta,t,a,_,o,_,v -> case <t,a> of { --- sta dummy s field of Ant and Tense
<Pres,Simul> => <sta ++ v.v ! VF (VPres o), [], []> ;
<Past,Simul> => <sta ++ v.v ! VF (VPret o), [], []> ;
<Fut, Simul> => <skola_V.s ! VF (VPres Act), [], sta ++ v.v ! VI (VInfin o)> ;
<Cond,Simul> => <skola_V.s ! VF (VPret Act), [], sta ++ v.v ! VI (VInfin o)> ;
<Pres,Anter> => <hava_V.s ! VF (VPres Act), [], sta ++ v.v ! VI (VSupin o)> ;
<Past,Anter> => <hava_V.s ! VF (VPret Act), [], sta ++ v.v ! VI (VSupin o)> ;
<Fut, Anter> => <skola_V.s ! VF (VPres Act), hava_V.s ! VI (VInfin Act), sta ++ v.v ! VI (VSupin o)> ;
<Cond,Anter> => <skola_V.s ! VF (VPret Act), hava_V.s ! VI (VInfin Act), sta ++ v.v ! VI (VSupin o)>
} ;
tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrV -> Str * Str = \sa,a,_,o,v ->
case a of {
Simul => <[], sa ++ v.v ! VI (VInfin o)> ; -- hon vill sova
Anter => <hava_V.s ! VI (VInfin Act), sa ++ v.v ! VI (VSupin o)> -- hon vill (ha) sovit
} ;
hava_V : V = P.mkV "ha" "har" "ha" "hade" "haft" "havd" ; -- havd not used
skola_V : V = P.mkV "skola" "ska" "ska" "skulle" "skolat" "skolad" ; ---- not used but ska and skulle
noObj : Agr => Str = \\_ => [] ;
addObj2VP : PrVerbPhrase -> (Agr => Str) -> PrVerbPhrase = \vp,obj -> vp ** {
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
@@ -663,71 +561,4 @@ oper
oper
be_V : PrV = lin PrV {
v = table {
VInf => "be" ;
VPres => "is" ;
VPast => "was" ;
VPPart => "been" ;
VPresPart => "being"
} ;
p,c1,c2 = [] ; isAux = True ; isSubjectControl,isRefl = False
} ;
negAdV : PredSwe.Pol -> Str = \p -> p.s ;
oper
---- have to split the tables to two to get reasonable PMCFG generation
will_Aux : 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 : 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 : 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 : 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 : 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"} ;
-}
}

17
lib/src/experimental/TransSwe.gf
View File

@@ -1,26 +1,27 @@
--# -path=.:../translator
concrete TransSwe of Trans =
RGLBaseSwe - [Pol]
RGLBaseSwe - [Pol,Tense]
,PredSwe
,DictionarySwe - [Pol]
,DictionarySwe - [Pol,Tense]
** open ResSwe, Prelude in {
flags
literal=Symb ;
{-
lin
LiftV v = v ** {v = v.s ; c1,c2 = [] ; isSubjectControl, isAux = False} ;
LiftV2 v = v ** {v = v.s ; c1 = v.c2 ; c2 = [] ; isSubjectControl, isAux = False} ;
LiftVS v = v ** {v = v.s ; c1,c2 = [] ; isSubjectControl, isAux = False} ;
LiftV v = {v = v.s ; p = v.part ; c1,c2 = [] ; isSubjectControl = False ; isAux,isRefl = False} ; ---- vtype : VType
LiftV2 v = {v = v.s ; p = v.part ; c1 = v.c2.s ; c2 = [] ; isSubjectControl = False ; isAux,isRefl = False} ; ---- vtype : VType
LiftVS v = {v = v.s ; p = v.part ; c1,c2 = [] ; isSubjectControl = False ; isAux,isRefl = False} ; ---- vtype : VType
{-
LiftAP ap = {s = \\_ => ap.s ! AgP3Sg Neutr ; c1,c2 = [] ; obj1 = \\_ => []} ; --- agr, isPre
-}
LiftAdv a = a ** {isAdV = False ; c1 = []} ;
LiftAdV a = a ** {isAdV = True ; c1 = []} ;
LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
-}
{-
LiftVQ : VQ -> PrV aQ ;
LiftVV : VV -> PrV aV ;

2
lib/src/swedish/StructuralSwe.gf
View File

@@ -152,7 +152,7 @@ lin
except_Prep = ss "utom" ;
as_CAdv = X.mkCAdv "lika" "som" ;
have_V2 = dirV2 (mkV "ha" "har" "ha" "hade" "haft" "haft") ; ---- pp
have_V2 = dirV2 (mkV "ha" "har" "ha" "hade" "haft" "havd") ;
lin language_title_Utt = ss "svenska" ;