diff --git a/lib/src/experimental/PredFunctor.gf b/lib/src/experimental/PredFunctor.gf index be508b3ff..f0deefd62 100644 --- a/lib/src/experimental/PredFunctor.gf +++ b/lib/src/experimental/PredFunctor.gf @@ -89,13 +89,13 @@ lin aNP a = a ; UseV a t p _ v = { - v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr v ; - inf = tenseInfV a.s a.a p.p Act v ; + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p active agr v ; + inf = \\vt => tenseInfV a.s a.a p.p active v vt ; c1 = v.c1 ; c2 = v.c2 ; part = v.p ; adj = noObj ; - obj1 = \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value + obj1 = \\a => reflPron a ; _ => \\_ => []}, defaultAgr> ; ---- not used, just default value obj2 = ; vvtype = v.vvtype ; adV = negAdV p ; --- just p.s in Eng @@ -105,8 +105,8 @@ lin } ; 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 ; + v = \\agr => tenseV (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 ; c1 = v.c1 ; c2 = v.c2 ; part = v.p ; @@ -117,12 +117,12 @@ lin adV = negAdV p ; adv = [] ; ext = [] ; - qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; AgentPassUseV a t p _ v np = { - 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 ; + v = \\agr => tenseV (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 ; c1 = v.c1 ; c2 = v.c2 ; part = v.p ; @@ -133,23 +133,23 @@ lin adV = negAdV p ; adv = appComplCase agentCase np ; ext = [] ; - qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; UseAP a t p _ ap = { - v = \\agr => be_Aux (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - inf = tenseInfV a.s a.a p.p Act be_V ; + v = \\agr => tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + inf = \\vt => tenseInfCopula a.s a.a p.p vt ; c1 = ap.c1 ; c2 = ap.c2 ; part = [] ; adj = \\a => ap.s ! agr2aagr a ; obj1 = ; obj2 = ; --- there are no A3's - vvtype = be_V.vvtype ; + vvtype = vvInfinitive ; ---- should come from AP: "eager to please" - "good at dancing" adV = negAdV p ; adv = [] ; ext = [] ; - qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; + qforms = \\agr => qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; } ; SlashV2 x vp np = vp ** { diff --git a/lib/src/experimental/PredInstanceEng.gf b/lib/src/experimental/PredInstanceEng.gf index c19835708..694480161 100644 --- a/lib/src/experimental/PredInstanceEng.gf +++ b/lib/src/experimental/PredInstanceEng.gf @@ -11,14 +11,18 @@ oper NPCase = ResEng.NPCase ; VForm = ResEng.VForm ; VVType = ResEng.VVType ; - ---oper STense = ResEng.Tense ; - -param - VAgr = VASgP1 | VASgP3 | VAPl ; - VType = VTAct | VTRefl | VTAux ; + 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 ; + subjCase : NPCase = NCase Nom ; objCase : NPCase = NPAcc ; @@ -77,6 +81,8 @@ oper vvInfinitive : VVType = VVInf ; + isRefl : PrVerb -> Bool = \v -> case v.vtype of {VTRefl => True ; _ => False} ; + ----------------------- -- concrete opers ----------------------- @@ -104,12 +110,17 @@ oper _ => } ; - qformsBe : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = + qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = \sta,t,a,p,agr -> let verb = be_AuxL sta t a p agr in ; -- is , not ---- TODO isn't , - tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> PrVerb -> Str * Str * Str = + tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \s,t,a,p,agr -> + be_Aux s t a p agr ; + tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str = \s,a,p,vt -> + tenseInfV s a p Act be_V vt ; + + 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 ; @@ -182,7 +193,7 @@ oper in ; - tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrVerb -> VVType => Str = \sa,a,p,o,v -> \\vt => + tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,p,o,v,vt -> let not = case p of {Pos => [] ; Neg => "not"} ; in @@ -275,9 +286,6 @@ oper ext = ext ; } ; - - - oper be_V : PrVerb = { s = table { diff --git a/lib/src/experimental/PredInstanceSwe.gf b/lib/src/experimental/PredInstanceSwe.gf new file mode 100644 index 000000000..3140ae5d0 --- /dev/null +++ b/lib/src/experimental/PredInstanceSwe.gf @@ -0,0 +1,163 @@ +instance PredInstanceSwe of PredInterface = open CommonScand, ResSwe, (P = ParadigmsSwe), (X = ParamX), Prelude in { + +--------------------- +-- parameters ------- +--------------------- + +oper + Gender = CommonScand.Gender ; + Agr = CommonScand.Agr ; + Case = CommonScand.Case ; + NPCase = CommonScand.NPForm ; + VForm = CommonScand.VForm ; + VVType = Unit ; ----- + VType = CommonScand.VType ; + + VAgr = Unit ; + + SVoice = CommonScand.Voice ; + +oper + active = CommonScand.Act ; + passive = CommonScand.Pass ; + + subjCase : NPCase = NPNom ; + objCase : NPCase = NPAcc ; + + agentCase : ComplCase = "av" ; + + ComplCase = Str ; -- preposition + + appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ; + noComplCase : ComplCase = [] ; + + noObj : Agr => Str = \\_ => [] ; + + NAgr = Number ; --- only Indef Nom forms are needed here + IPAgr = Number ; ----{g : Gender ; n : Number} ; --- two separate fields in RGL + + defaultAgr : Agr = {g = Utr ; n = Sg ; p = P3} ; + +-- omitting rich Agr information + agr2vagr : Agr -> VAgr = \a -> UUnit ; + + agr2aagr : Agr -> AAgr = \a -> a ; + +--- could use this? + agr2aformpos : Agr -> AFormPos = \a -> + case a.n of { + Sg => Strong (GSg a.g) ; + Pl => Strong GPl + } ; + + agr2nagr : Agr -> NAgr = \a -> a.n ; + +-- restoring full Agr + ipagr2agr : IPAgr -> Agr = \a -> {g = Utr ; n = a ; p = P3} ; ---- + + ipagr2vagr : IPAgr -> VAgr = \n -> UUnit ; + +--- this is only needed in VPC formation + vagr2agr : VAgr -> Agr = \a -> defaultAgr ; + + vPastPart : PrVerb -> AAgr -> Str = \v,a -> v.s ! VI (VPtPret (agr2aformpos a) Nom) ; + vPresPart : PrVerb -> AAgr -> Str = \v,a -> v.s ! VI (VPtPres Sg Indef Nom) ; + + vvInfinitive : VVType = UUnit ; ---- + + isRefl : PrVerb -> Bool = \v -> case v.vtype of {VRefl => True ; _ => False} ; + + +------------------ +--- opers -------- +------------------ + +oper + reflPron : Agr -> Str = ResSwe.reflPron ; + + 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 ! UUnit ++ + 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 -> PrVerb -> Str * Str = + \sta,t,a,p,agr,v -> <[],[]> ; ----- not needed in Swedish + + + declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + 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 : PrQuestionClause -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; + + questSubordCl : PrQuestionClause -> Str = \cl -> + let + rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl + in case cl.focType of { + 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 = "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 : {s : Str ; p : Polarity} -> Str = \p -> p.s ++ case p.p of {Pos => [] ; Neg => "inte"} ; + + tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str = --- Polarity, VAgr not needed in Swe + \sta,t,a,_,o,_,v -> + let act = CommonScand.Act in + case of { --- sta dummy s field of Ant and Tense + => ; + => ; + => ; + => ; + => ; + => ; + => ; + => + } ; + + tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str = \sa,a,_,o,v,_ -> ---- vvtype + case a of { + Simul => sa ++ v.s ! VI (VInfin o) ; -- hon vill sova + Anter => hava_V.s ! VI (VInfin CommonScand.Act) ++ sa ++ v.s ! VI (VSupin o) -- hon vill (ha) sovit ---- discont? + } ; + + tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = + \s,t,a,p,_ -> tenseV s t a p CommonScand.Act UUnit (liftV be_V) ; + tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str = + \s,a,p,vt -> tenseInfV s a p CommonScand.Act (liftV be_V) vt ; + + hava_V : Verb = P.mkV "ha" "har" "ha" "hade" "haft" "havd" ; -- havd not used + be_V : Verb = P.mkV "vara" "är" "var" "varit" "varen" "varna" ; + skola_V : Verb = 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> ; + } ; + + addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { + ext = ext ; + } ; + + not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ; + + liftV : Verb -> PrVerb = \v -> + {s = v.s ; p = v.part ; c1,c2 = [] ; isSubjectControl = False ; vtype = v.vtype ; vvtype = vvInfinitive} ; ---- vvtype + +--- junk + + qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> PrVerb -> Str * Str = + \sta,t,a,p,agr,v -> <[],[]> ; + qformsCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str = + \sta,t,a,p,agr -> <[],[]> ; + + +} \ No newline at end of file diff --git a/lib/src/experimental/PredInterface.gf b/lib/src/experimental/PredInterface.gf index 3b67d873b..a42076088 100644 --- a/lib/src/experimental/PredInterface.gf +++ b/lib/src/experimental/PredInterface.gf @@ -11,6 +11,7 @@ oper Anteriority : PType = X.Anteriority ; Polarity : PType = X.Polarity ; STense : PType = X.Tense ; + SVoice : PType ; param Voice = Act | Pass ; --- should be in ParamX @@ -32,11 +33,14 @@ oper -- language dependent -param - VAgr ; -- agr features that a verb form depends on - VType ; -- reflexive, auxiliary, deponent,... + + VAgr : PType ; -- agr features that a verb form depends on + VType : PType ; -- reflexive, auxiliary, deponent,... oper + active : SVoice ; + passive : SVoice ; + subjCase : NPCase ; objCase : NPCase ; @@ -76,6 +80,13 @@ oper vvInfinitive : VVType ; + isRefl : PrVerb -> Bool ; + +--- 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 ; + + ------------------------------- --- type synonyms ------------------------------- @@ -132,9 +143,12 @@ oper infVP : VVType -> Agr -> PrVerbPhrase -> Str ; - tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> PrVerb -> Str * Str * Str ; + tenseV : Str -> STense -> Anteriority -> Polarity -> SVoice -> VAgr -> PrVerb -> Str * Str * Str ; - tenseInfV : Str -> Anteriority -> Polarity -> Voice -> PrVerb -> VVType => Str ; + tenseInfV : Str -> Anteriority -> Polarity -> SVoice -> PrVerb -> VVType -> Str ; + + tenseCopula : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str ; + tenseInfCopula : Str -> Anteriority -> Polarity -> VVType -> Str ; declCl : PrClause -> Str ; declSubordCl : PrClause -> Str ; diff --git a/lib/src/experimental/PredSwe.gf b/lib/src/experimental/PredSwe.gf index 124de9bf4..5e4fd9998 100644 --- a/lib/src/experimental/PredSwe.gf +++ b/lib/src/experimental/PredSwe.gf @@ -1,564 +1,4 @@ -concrete PredSwe of Pred = CatSwe - [Tense] ** open ResSwe, (P = ParadigmsSwe), CommonScand, ParamX, Prelude in { - ---------------------- --- parameters ------- ---------------------- - --- standard general -param -{- - Number = Sg | Pl ; - Person = P1 | P2 | P3 ; - Anteriority = Simul | Anter ; - Polarity = Pos | Neg ; - STense = Pres | Past | Fut | Cond ; - - Voice = Act | Pass ; --} - Unit = UUnit ; - --- predication specific - FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover - -{- --- standard Swedish - Gender = Utr | Neutr ; - Agr = {g : Gender ; n : Number ; p : Person} ; - Case = Nom | Gen ; - NPForm = NPNom | NPAcc | NPPoss GenNum Case ; - VForm = VF VFin | VI VInf ; - --- above, type names shared with Eng, below Scandinavian only - VFin = VPres Voice | VPret Voice | VImper Voice ; - VInf = VInfin Voice | VSupin Voice | VPtPret AFormPos Case | VPtPres Number Species Case ; - VType = VAct | VPass | VRefl ; - GenNum = GSg Gender | GPl ; - AFormPos = Strong GenNum | Weak Number ; - Species = Indef | Def ; --} - -oper - STense = ParamX.Tense ; - --- language dependent -oper - VAgr = Unit ; - -oper - subjCase : NPForm = NPNom ; - objCase : NPForm = NPAcc ; - - agentCase : ComplCase = "av" ; - - ComplCase = Str ; -- preposition - - NounPhrase = {s : NPForm => Str ; a : Agr} ; - Preposition = {s : Str} ; - - appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ; - noComplCase : ComplCase = [] ; - prepComplCase : Preposition -> ComplCase = \p -> p.s ; - - noObj : Agr => Str = \\_ => [] ; - - NAgr = Number ; --- only Indef Nom forms are needed here - AAgr = AFormPos ; - IPAgr = {g : Gender ; n : Number} ; --- two separate fields in RGL - - defaultAgr : Agr = {g = Utr ; n = Sg ; p = P3} ; - --- omitting rich Agr information - agr2vagr : Agr -> VAgr = \a -> UUnit ; - - agr2aagr : Agr -> AAgr = \a -> case a.n of { - Sg => Strong (GSg a.g) ; - Pl => Strong GPl - } ; - - agr2nagr : Agr -> NAgr = \a -> a.n ; - --- restoring full Agr - ipagr2agr : IPAgr -> Agr = \a -> a ** {p = P3} ; - - ipagr2vagr : IPAgr -> VAgr = \n -> UUnit ; - ---- this is only needed in VPC formation - vagr2agr : VAgr -> Agr = \a -> defaultAgr ; - - vPastPart : AAgr -> VForm = \a -> VI (VPtPret a Nom) ; - vPresPart : AAgr -> VForm = \a -> VI (VPtPres Sg Indef Nom) ; ---- Sg - ------------------------------------- --- lincats -------------------------------------- -lincat - --- standard general - 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} ; - - PrV = { - v : VForm => Str ; - p : Str ; -- verb particle - c1 : ComplCase ; - c2 : ComplCase ; - isSubjectControl : Bool ; - isAux : Bool ; - isRefl : Bool ; - } ; - -oper - PrVerbPhrase = { - v : VAgr => Str * Str * Str ; -- would,have,slept - inf : Str * Str ; -- have,slept - c1 : ComplCase ; - c2 : ComplCase ; - part : Str ; -- (look) up - adj : Agr => Str ; - obj1 : (Agr => Str) * Agr ; -- agr for object control - obj2 : (Agr => Str) * Bool ; -- subject control = True - adv : Str ; - adV : Str ; - ext : Str ; - qforms : VAgr => Str * Str -- special Swe for introducing "do" in questions - } ; - - PrClause = { - v : Str * Str * Str ; - inf : Str * Str ; - adj,obj1,obj2 : Str ; - adv : Str ; - adV : Str ; - ext : Str ; - subj : Str ; - c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency - qforms : Str * Str - } ; - -lincat - PrVP = PrVerbPhrase ; - PrCl = PrClause ; - - PrQCl = PrClause ** { - foc : Str ; -- the focal position at the beginning: *who* does she love - focType : FocusType ; --- if already filled, then use other place: who loves *who* - } ; - - VPC = { - v : VAgr => Str ; - inf : Agr => Str ; - c1 : ComplCase ; - c2 : ComplCase - } ; - - ClC = { - s : Str ; - c3 : ComplCase ; - } ; - - PrAdv = {s : Str ; isAdV : Bool ; c1 : Str} ; - PrS = {s : Str} ; - - PrAP = { - s : AAgr => Str ; - c1, c2 : ComplCase ; - obj1 : Agr => Str - } ; - - PrCN = { - s : NAgr => Str ; - c1, c2 : ComplCase ; - obj1 : Agr => Str - } ; - -{- --- language specific - NP = {s : NPCase => Str ; a : Agr} ; - IP = {s : NPCase => Str ; n : IPAgr} ; ---- n : Number in Swe - Conj = {s1,s2 : Str ; n : Number} ; --} - - --- reference linearizations for chunking - -linref - PrVP = \vp -> - let - agr = defaultAgr ; - vagr = agr2vagr agr ; - verb = vp.v ! vagr ; - in - verb.p1 ++ verb.p2 ++ vp.adV ++ verb.p3 ++ vp.part ++ - vp.adj ! agr ++ vp.obj1.p1 ! agr ++ vp.obj2.p1 ! agr ++ vp.adv ++ vp.ext ; - - PrCl = \cl -> declCl cl ; ----- PrQCl = \qcl -> questCl (lin PrQCl qcl) ; - PrAdv = \adv -> adv.c1 ++ adv.s ; - PrAP = \ap -> ap.s ! agr2aagr defaultAgr ++ ap.obj1 ! defaultAgr ; - PrCN = \cn -> cn.s ! Sg ++ cn.obj1 ! defaultAgr ; - ----------------------------- ---- linearization rules ---- ----------------------------- - -lin - --- standard general - - TPres = {s = [] ; t = Pres} ; - TPast = {s = [] ; t = Past} ; - TFut = {s = [] ; t = Fut} ; - TCond = {s = [] ; t = Cond} ; - ASimul = {s = [] ; a = Simul} ; - AAnter = {s = [] ; a = Anter} ; - PPos = {s = [] ; p = Pos} ; - PNeg = {s = [] ; p = Neg} ; - --- predication specific - - aNone, aS, aV, aA, aQ, aN = {s = []} ; - aNP a = a ; - - UseV a t p _ v = { - v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr v ; - inf = tenseInfV a.s a.a p.p Act v ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = noObj ; - obj1 = \\a => reflPron a ; False => \\_ => []}, defaultAgr> ; ---- not used, just default value - obj2 = ; - adV = negAdV p ; --- just p.s in Swe - adv = [] ; - ext = [] ; - 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 ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = noObj ; - obj1 = ; ---- not used, just default value - obj2 = ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves" - adV = negAdV p ; - adv = [] ; - ext = [] ; - qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - } ; - - AgentPassUseV a t p _ v np = { - 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 ; - c1 = v.c1 ; - c2 = v.c2 ; - part = v.p ; - adj = \\a => [] ; - obj1 = ; - obj2 = ; - adV = negAdV p ; - adv = appComplCase agentCase np ; - ext = [] ; - qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - } ; - - UseAP a t p _ ap = { - v = \\agr => be_Aux (a.s ++ t.s ++ p.s) t.t a.a p.p agr ; - inf = tenseInfV a.s a.a p.p Act be_V ; - c1 = ap.c1 ; - c2 = ap.c2 ; - part = [] ; - adj = \\a => ap.s ! agr2aagr a ; - obj1 = ; - obj2 = ; --- there are no A3's - adV = negAdV p ; - adv = [] ; - ext = [] ; - 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 - } ; - - SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved - - ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form - - 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 - - ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm - - SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form - - SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form - - SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm - - SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm - - SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form - - ReflVP x vp = vp ** { - obj1 : (Agr => Str) * Agr = <\\a => reflPron ! a, defaultAgr> ; --- defaultAgr will not be used but subj.a instead - } ; - - 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 ; - subj = np.s ! subjCase ; - adj = vp.adj ! np.a ; - obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj - obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase - c3 = noComplCase ; -- for one more prep to build ClSlash - qforms = vp.qforms ! agr2vagr np.a ; - } ; - - PrepCl p x cl = cl ** { -- Cl/NP ::= Cl PP/NP - c3 = prepComplCase p ; - } ; - - SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP - adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added - c3 = noComplCase ; -- complCase has been consumed - } ; - - --- QCl ::= Cl by just adding focus field - QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: does she love us - - 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 {g = ip.g ; n = ip.n} ; ipv = ipagr2vagr {g = ip.g ; n = ip.n} - in - vp ** { - v = vp.v ! ipv ; - foc = ip.s ! subjCase ; -- who (loves her) - focType = FocSubj ; - subj = [] ; - adj = vp.adj ! ipa ; - 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 ipa ; - } ; - - QuestSlash x ip cl = - let - prep = cl.c3 ; - ips = ip.s ! objCase ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip - focobj = case cl.focType of { - NoFoc => ; -- put ip object to focus if there is no focus yet - t => <[], prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus - } ; - in - cl ** { -- preposition stranding - foc = focobj.p1 ; - focType = focobj.p3 ; - obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field? - c3 = focobj.p4 ; - } ; -{- ----- this is giving four records instead of two AR 5/2/2014 - | - cl ** { -- pied piping - foc = focobj.p4 ++ focobj.p1 ; - focType = focobj.p3 ; - obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field? - c3 = noComplCase ; - } ; --} - - UseCl cl = {s = declCl cl} ; - UseQCl cl = {s = questCl cl} ; - ----- UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ; - - UttS s = s ; - - - AdvCl x a cl = case a.isAdV of { - True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ; - False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1} - } ; - - AdvQCl x a cl = case a.isAdV of { - True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ; - False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1} - } ; - -{- ----------------------------- - - PresPartAP x v = { - s = \\a => v.v ! vPresPart a ; - c1 = v.c1 ; -- looking at her - c2 = v.c2 ; - obj1 = noObj ; - } ; - - PastPartAP x v = { - s = \\a => v.v ! vPastPart a ; - c1 = v.c1 ; - c2 = v.c2 ; - obj1 = noObj ; - } ; - - AgentPastPartAP x v np = { - s = \\a => v.v ! vPastPart a ; - c1 = v.c1 ; - c2 = v.c2 ; - obj1 = \\_ => appComplCase agentCase np ; ---- addObj - } ; - - - StartVPC c x v w = { ---- some loss of quality seems inevitable - v = \\a => - let - vv = v.v ! a ; - wv = w.v ! a ; - vpa = vagr2agr a ; - in - vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++ - v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase - ++ c.s2 ++ - wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase - w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ; - inf = \\a => - PredSwe.infVP a v ++ c.s2 ++ PredSwe.infVP a w ; - c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... - c2 = [] ; ---- w.c2 ? - } ; - - UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable - v = \\a => <[], [], vpc.v ! a> ; - inf = <[], vpc.inf ! defaultAgr> ; ---- agreement - c1 = vpc.c1 ; - c2 = vpc.c2 ; - part = [] ; - adj = \\a => [] ; - obj1 = ; - obj2 = ; - adv,adV = [] ; - ext = [] ; - qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did - } ; - - StartClC c x a b = { - s = declCl (lin Cl a) ++ c.s2 ++ declCl (lin Cl b) ; - c3 = b.c3 ; ---- - } ; - - UseClC x cl = { - subj = [] ; - v = <[],[],cl.s> ; ---- - inf = <[],[]> ; - adj = [] ; - obj1 = [] ; - obj2 = [] ; - adV = [] ; - adv = [] ; - ext = [] ; - c3 = cl.c3 ; - qforms = <[],[]> ; ---- qforms - } ; - - ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ; - - - --} - - - - - - ------------------- ---- opers -------- ------------------- - -oper - - declCl : PrClause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ; - 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 -> 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 - in case cl.focType of { - 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 = "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 of { --- sta dummy s field of Ant and Tense - => ; - => ; - => ; - => ; - => ; - => ; - => ; - => - } ; - - 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 => -- 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> ; - } ; - - addExtVP : PrVerbPhrase -> Str -> PrVerbPhrase = \vp,ext -> vp ** { - ext = ext ; - } ; - - - -} \ No newline at end of file +concrete PredSwe of Pred = + CatSwe [Ant,NP,Utt,IP,IAdv,Conj] ** + PredFunctor with + (PredInterface = PredInstanceSwe) ; diff --git a/lib/src/experimental/TransSwe.gf b/lib/src/experimental/TransSwe.gf index ad8d755af..48ddd43c8 100644 --- a/lib/src/experimental/TransSwe.gf +++ b/lib/src/experimental/TransSwe.gf @@ -5,35 +5,39 @@ concrete TransSwe of Trans = ,PredSwe ,DictionarySwe - [Pol,Tense] - ** open ResSwe, Prelude in { + ** open ResSwe, PredInstanceSwe, Prelude in { flags literal=Symb ; -lin - 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 +oper + liftV = PredInstanceSwe.liftV ; +lin + LiftV v = liftV v ; + LiftV2 v = : PrVerb> ** {c1 = v.c2.s} ; + LiftVS v = liftV v ; + LiftVQ v = liftV v ; + LiftVA v = liftV v ; ---- c1? + LiftVN v = liftV v ; ---- c1? + LiftVV v = : PrVerb> ** {c1 = v.c2.s} ; + + LiftV3 v = : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ; {- - LiftAP ap = {s = \\_ => ap.s ! AgP3Sg Neutr ; c1,c2 = [] ; obj1 = \\_ => []} ; --- agr, isPre + LiftV2S v = liftV v ** {c1 = v.c2} ; + LiftV2Q v = liftV v ** {c1 = v.c2} ; + LiftV2V v = liftV v ** {c1 = v.c2 ; c2 = v.c3 ; isSubjectControl = False ; vvtype = v.typ} ; ---- subj control should be defined in V2V + LiftV2A v = liftV v ** {c1 = v.c2} ; + LiftV2N v = liftV v ** {c1 = v.c2} ; -} + +---- LiftAP ap = ap ** {c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre +---- LiftCN cn = {s = \\n => cn.s ! n ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ; + 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 ; - LiftVA : VA -> PrV aA ; - LiftVN : VA -> PrV aN ; ---- - - LiftV3 : V3 -> PrV (aNP (aNP aNone)) ; - LiftV2S : V2S -> PrV (aNP aS) ; - LiftV2Q : V2Q -> PrV (aNP aQ) ; - LiftV2V : V2V -> PrV (aNP aV) ; - LiftV2A : V2A -> PrV (aNP aA) ; - LiftV2N : V2A -> PrV (aNP aN) ; ---- --} } +