From 11395b50f0abaec7c0d57f1931a7f76e1ba29caa Mon Sep 17 00:00:00 2001 From: aarne Date: Sat, 25 Jan 2014 17:35:24 +0000 Subject: [PATCH] compound tenses in PredicationSwe --- lib/src/experimental/Predication.gf | 23 ++- lib/src/experimental/PredicationSwe.gf | 188 ++++++++++++++++++------- 2 files changed, 158 insertions(+), 53 deletions(-) diff --git a/lib/src/experimental/Predication.gf b/lib/src/experimental/Predication.gf index 42b466208..df5701c84 100644 --- a/lib/src/experimental/Predication.gf +++ b/lib/src/experimental/Predication.gf @@ -11,6 +11,7 @@ cat Temp ; Pol ; Cl Arg ; + ClC Arg ; -- conjunction of Cl QCl Arg ; NP ; Adv ; @@ -21,11 +22,12 @@ cat IP ; Prep ; Conj ; + IAdv ; fun aNone, aS, aV, aQ, aA : Arg ; aNP : Arg -> Arg ; - TPres, TPast : Temp ; + TPres, TPast, TPerf, TFut : Temp ; PPos, PNeg : Pol ; UseV : Temp -> Pol -> (a : Arg) -> V a -> VP a ; @@ -45,7 +47,8 @@ fun PredVP : (a : Arg) -> NP -> VP a -> Cl a ; - PrepCl : Prep -> (a : Arg) -> Cl a -> Cl (aNP a) ; + PrepCl : Prep -> (a : Arg) -> Cl a -> Cl (aNP a) ; -- slash creation (S/NP): hon tittar på (oss) + SlashClNP : (a : Arg) -> Cl (aNP a) -> NP -> Cl a ; -- slash consumption: hon tittar på + oss AdvVP : Adv -> (a : Arg) -> VP a -> VP a ; AdVVP : AdV -> (a : Arg) -> VP a -> VP a ; @@ -53,19 +56,27 @@ fun ReflVP : (a : Arg) -> VP (aNP a) -> VP a ; -- refl on first position (direct object) ReflVP2 : (a : Arg) -> VP (aNP (aNP a)) -> VP (aNP a) ; -- refl on second position (indirect object) - QuestVP : (a : Arg) -> IP -> VP a -> QCl a ; - QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ; - QuestCl : (a : Arg) -> Cl a -> QCl a ; + QuestVP : (a : Arg) -> IP -> VP a -> QCl a ; + QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ; + QuestCl : (a : Arg) -> Cl a -> QCl a ; + QuestIAdv : (a : Arg) -> IAdv -> Cl a -> QCl a ; UseCl : Cl aNone -> S ; UseQCl : QCl aNone -> S ; -- deprecate QS UttS : S -> Utt ; +-- VP coordination + StartVPC : Conj -> (a : Arg) -> VP a -> VP a -> VPC a ; ContVPC : (a : Arg) -> VP a -> VPC a -> VPC a ; UseVPC : (a : Arg) -> VPC a -> VP a ; +-- clause coordination, including "she loves and we look at (her)" + StartClC : Conj -> (a : Arg) -> Cl a -> Cl a -> ClC a ; + ContClC : (a : Arg) -> Cl a -> ClC a -> ClC a ; + UseClC : (a : Arg) -> ClC a -> Cl a ; + -- lexicon sleep_V : V aNone ; @@ -101,4 +112,6 @@ fun and_Conj : Conj ; + why_IAdv : IAdv ; + } \ No newline at end of file diff --git a/lib/src/experimental/PredicationSwe.gf b/lib/src/experimental/PredicationSwe.gf index bfa2967ba..4051ff965 100644 --- a/lib/src/experimental/PredicationSwe.gf +++ b/lib/src/experimental/PredicationSwe.gf @@ -3,9 +3,11 @@ concrete PredicationSwe of Predication = open Prelude in { param Agr = Sg | Pl ; Case = Nom | Acc ; - Tense = Pres | Past ; + Tense = Pres | Past | Perf | Fut ; Polarity = Pos | Neg ; - VForm = Inf | VT Tense ; + VForm = Inf | VPres | VPret | VSup ; + + FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover oper defaultAgr = Sg ; @@ -21,7 +23,7 @@ lincat } ; VP = { - v : Str ; + v : Str * Str ; inf : Str ; c1 : Str ; c2 : Str ; @@ -34,7 +36,7 @@ lincat } ; Cl = { - v : Str ; + v : Str * Str ; inf : Str ; adj,obj1,obj2 : Str ; adv : Str ; @@ -45,7 +47,7 @@ lincat } ; QCl = { - v : Str ; + v : Str * Str ; inf : Str ; adj,obj1,obj2 : Str ; adv : Str ; @@ -54,7 +56,7 @@ lincat subj : Str ; c3 : Str ; foc : Str ; -- the focal position at the beginning, e.g. *vem* älskar hon - hasFoc : Bool ; --- if already filled, then use other place: vem älskar *vem* + focType : FocusType ; --- if already filled, then use other place: vem älskar *vem* } ; VPC = { @@ -64,6 +66,11 @@ lincat c2 : Str } ; + ClC = { + s : Str ; + c3 : Str ; ---- which prep + } ; + Temp = {s : Str ; t : Tense} ; Pol = {s : Str ; p : Polarity} ; NP = {s : Case => Str ; a : Agr} ; @@ -75,6 +82,7 @@ lincat IP = {s : Str ; a : Agr} ; Prep = {s : Str} ; Conj = {s : Str} ; + IAdv = {s : Str} ; lin aNone, aS, aV, aA, aQ = {s = []} ; @@ -82,12 +90,14 @@ lin TPres = {s = [] ; t = Pres} ; TPast = {s = [] ; t = Past} ; + TPerf = {s = [] ; t = Perf} ; + TFut = {s = [] ; t = Fut} ; PPos = {s = [] ; p = Pos} ; PNeg = {s = [] ; p = Neg} ; UseV t p _ v = { - v = t.s ++ v.v ! VT t.t ; - inf = t.s ++ aux t.t ++ v.v ! Inf ; + v = tenseV t.s t.t v ; + inf = t.s ++ auxInf t.t v ; c1 = v.c1 ; c2 = v.c2 ; adj = \\a => [] ; @@ -99,8 +109,8 @@ lin } ; UseAP t p _ ap = { - v = t.s ++ be_Aux (VT t.t) ; - inf = t.s ++ p.s ++ aux t.t ++ be_Aux Inf ; + v = tenseV t.s t.t be_V ; + inf = t.s ++ p.s ++ auxInf t.t be_V ; c1 = ap.c1 ; c2 = ap.c2 ; adj = \\a => ap.s ! a ; @@ -147,7 +157,7 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = declCl (lin Cl cl) ; + ext = that_Compl ++ declSubordCl (lin Cl cl) ; } ; ComplVQ x vp qcl = { @@ -160,7 +170,7 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = questCl qcl ; + ext = questSubordCl qcl ; } ; ComplVV x vp vpo = { @@ -199,7 +209,20 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = declCl (lin Cl cl) ; + ext = that_Compl ++ declSubordCl (lin Cl cl) ; + } ; + + SlashV2Q x vp cl = { + v = vp.v ; + inf = vp.inf ; + c1 = vp.c1 ; + c2 = vp.c2 ; + adj = vp.adj ; + obj1 = vp.obj1 ; + obj2 = vp.obj2 ; + adV = vp.adV ; + adv = vp.adv ; + ext = questSubordCl (lin QCl cl) ; } ; SlashV2V x vp vpo = { @@ -215,6 +238,19 @@ lin ext = vp.ext ; } ; + SlashV2A x vp ap = { + v = vp.v ; + inf = vp.inf ; + c1 = vp.c1 ; + c2 = vp.c2 ; + adj = vp.adj ; + obj1 = vp.obj1 ; + obj2 = <\\a => ap.s ! a, vp.obj2.p2> ; + adV = vp.adV ; + adv = vp.adv ; + ext = vp.ext ; + } ; + AdvVP adv _ vp = { v = vp.v ; inf = vp.inf ; @@ -293,11 +329,27 @@ lin c3 = p.s ; -- for one more prep to build ClSlash } ; - QuestCl x cl = cl ** {foc = [] ; hasFoc = False} ; -- verb first: älskar hon oss + SlashClNP x cl np = { + subj = cl.subj ; + v = cl.v ; + inf = cl.inf ; + adj = cl.adj ; + obj1 = cl.obj1 ; + obj2 = cl.obj2 ; + adV = cl.adV ; + adv = cl.adv ++ cl.c3 ++ np.s ! Acc ; + ext = cl.ext ; + c3 = [] ; + } ; + + + + QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- verb first: älskar hon oss + QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; QuestVP x ip vp = { foc = ip.s ; -- vem älskar henne - hasFoc = True ; + focType = FocSubj ; subj = [] ; v = vp.v ; inf = vp.inf ; @@ -313,13 +365,13 @@ lin QuestSlash x ip cl = let ips = cl.c3 ++ ip.s ; ---- c3? - focobj = case cl.hasFoc of { - True => <[],ips> ; - False => + focobj = case cl.focType of { + NoFoc => ; -- put ip object to focus + t => <[], ips, t> -- put ip object in situ } ; in { foc = focobj.p1 ; - hasFoc = True ; + focType = focobj.p3 ; subj = cl.subj ; v = cl.v ; inf = cl.inf ; @@ -339,9 +391,9 @@ lin StartVPC c x v w = { ---- some loss of quality seems inevitable v = \\a => - v.v ++ v.adV ++ v.adj ! a ++ v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext + v.v.p1 ++ v.adV ++ v.v.p2 ++ v.adj ! a ++ v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ++ c.s ++ - w.v ++ w.adV ++ w.adj ! a ++ w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ; + w.v.p1 ++ w.adV ++ w.v.p2 ++ w.adj ! a ++ w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ; inf = \\a => infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ; c1 = [] ; --- w.c1 ; --- the full story is to unify v and w... @@ -349,8 +401,8 @@ lin } ; UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable - v = vpc.v ! Sg ; ---- agreement - inf = vpc.inf ! Sg ; ---- agreement + v = <[], vpc.v ! defaultAgr> ; ---- agreement + inf = vpc.inf ! defaultAgr ; ---- agreement c1 = vpc.c1 ; c2 = vpc.c2 ; adj = \\a => [] ; @@ -360,22 +412,40 @@ lin ext = [] ; } ; + StartClC c x a b = { + s = declCl (lin Cl a) ++ c.s ++ declCl (lin Cl b) ; + c3 = b.c3 ; ---- + } ; - sleep_V = mkV "sova" "sover" "sov" ; - walk_V = mkV "gå" "går" "gick" ; - love_V2 = mkV "älska" "älskar" "älskade" ; - look_V2 = mkV "titta" "tittar" "tittade" "på" [] ; - believe_VS = mkV "tro" "tror" "trodde" ; - tell_V2S = mkV "berätta" "berättar" "berättade" "för" [] ; - prefer_V3 = mkV "föredra" "föredrar" "föredrog" [] "framför" ; - want_VV = mkV "vilja" "vill" "ville" ; - force_V2V = {v = table {Inf => "tvinga" ; VT Pres => "tvingar" ; VT Past => "tvingade"} ; + UseClC x cl = { + subj = [] ; + v = <[],cl.s> ; ---- + inf = [] ; + adj = [] ; + obj1 = [] ; + obj2 = [] ; + adV = [] ; + adv = [] ; + ext = [] ; + c3 = cl.c3 ; + } ; + + sleep_V = mkV "sova" "sover" "sov" "sovit" ; + walk_V = mkV "gå" "går" "gick" "gått" ; + love_V2 = mkV "älska" "älskar" "älskade" "älskat" ; + look_V2 = mkV "titta" "tittar" "tittade" "tittat" "på" [] ; + believe_VS = mkV "tro" "tror" "trodde" "trott" ; + tell_V2S = mkV "berätta" "berättar" "berättade" "berättat" "för" [] ; + prefer_V3 = mkV "föredra" "föredrar" "föredrog" "föredragit" [] "framför" ; + want_VV = mkV "vilja" "vill" "ville" "velat" ; + force_V2V = {v = table {Inf => "tvinga" ; VPres => "tvingar" ; VPret => "tvingade" ; VSup => "tvingat"} ; c1 = [] ; c2 = "att" ; isSubjectControl = False} ; - promise_V2V = mkV "lova" "lovar" "lovade" [] "att" ; - wonder_VQ = mkV "undra" "undrar" "undrade" ; - become_VA = mkV "bli" "blir" "blev" ; - make_V2A = {v = table {Inf => "göra" ; VT Pres => "gör" ; VT Past => "gjorde"} ; + promise_V2V = mkV "lova" "lovar" "lovade" "lovat" [] "att" ; + wonder_VQ = mkV "undra" "undrar" "undrade" "undrat" ; + become_VA = mkV "bli" "blir" "blev" "blivit" ; + make_V2A = {v = table {Inf => "göra" ; VPres => "gör" ; VPret => "gjorde" ; VSup => "gjort"} ; c1 = [] ; c2 = [] ; isSubjectControl = False} ; + ask_V2Q = mkV "fråga" "frågar" "frågade" "frågat" ; old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ; married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ; @@ -396,23 +466,25 @@ lin and_Conj = {s = "och"} ; + why_IAdv = {s = "varför"} ; + oper mkV = overload { - mkV : (x,y,z : Str) -> V = \x,y,z -> - lin V {v = table {Inf => x ; VT Pres => y ; VT Past => z} ; c1 = [] ; c2 = [] ; isSubjectControl = True} ; - mkV : (x,y,z : Str) -> Str -> Str -> V = \x,y,z,p,q -> - lin V {v = table {Inf => x ; VT Pres => y ; VT Past => z} ; c1 = p ; c2 = q ; isSubjectControl = True} ; + mkV : (x,y,z,u : Str) -> V = \x,y,z,u -> + lin V {v = table {Inf => x ; VPres => y ; VPret => z ; VSup => u} ; c1 = [] ; c2 = [] ; isSubjectControl = True} ; + mkV : (x,y,z,u : Str) -> Str -> Str -> V = \x,y,z,u,p,q -> + lin V {v = table {Inf => x ; VPres => y ; VPret => z ; VSup => u} ; c1 = p ; c2 = q ; isSubjectControl = True} ; } ; - be_Aux : VForm -> Str = \t -> case t of { - Inf => "vara" ; - VT Pres => "är" ; - VT Past => "var" - } ; + be_V : V = mkV "vara" "är" "var" "varit" ; + + have_V : V = mkV "ha" "har" "hade" "haft" ; + + shall_V : V = mkV "skola" "ska" "skulle" "skolat" ; neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ; - aux : Tense -> Str = \t -> case t of {Pres => [] ; Past => "ha"} ; + auxInf : Tense -> V -> Str = \t,v -> case t of {Pres | Fut => v.v ! Inf ; _ => have_V.v ! Inf ++ v.v ! VSup} ; --- many tenses give the same form reflPron : Agr -> Str = \a -> case a of {Sg => "sig" ; Pl => "oss"} ; @@ -420,6 +492,26 @@ oper let a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} in vp.adV ++ vp.inf ++ vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; - declCl : Cl -> Str = \cl -> cl.subj ++ cl.v ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; - questCl : QCl -> Str = \cl -> cl.foc ++ cl.v ++ cl.subj ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + tenseV : Str -> Tense -> V -> Str * Str = \s,t,v -> case t of { --- s : Str is the dummy s field of Temp + Pres => ; + Past => ; + Perf => ; + Fut => + } ; + + declCl : Cl -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + declSubordCl : Cl -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + declInvCl : Cl -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + + questCl : QCl -> Str = \cl -> + cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + questSubordCl : QCl -> Str = \cl -> + case cl.focType of { + NoFoc => "om" ++ cl.foc ++ cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + FocObj => cl.foc ++ cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; + FocSubj => cl.foc ++ "som" ++ cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext + } ; + + that_Compl : Str = "att" | [] ; + } \ No newline at end of file