diff --git a/lib/src/experimental/PredicationEng.gf b/lib/src/experimental/PredicationEng.gf index 43d2849a3..1eca86a45 100644 --- a/lib/src/experimental/PredicationEng.gf +++ b/lib/src/experimental/PredicationEng.gf @@ -9,7 +9,7 @@ concrete PredicationEng of Predication = open Prelude in { param Agr = Sg | Pl ; Case = Nom | Acc ; - STense = Pres | Past | Perf | Fut ; + STense = Pres | Past | Fut | Cond ; Anteriority = Simul | Anter ; Polarity = Pos | Neg ; VForm = VInf | VPres | VPast | VPastPart | VPresPart ; @@ -30,10 +30,11 @@ lincat c1 : ComplCase ; c2 : ComplCase ; isSubjectControl : Bool ; + isAux : Bool ; } ; VP = { - v : Str * Str * Str ; -- ska,ha,sovit + v : Agr => Str * Str * Str ; -- ska,ha,sovit inf : Str * Str ; -- ha,sovit c1 : ComplCase ; c2 : ComplCase ; @@ -108,7 +109,7 @@ lin TPres = {s = [] ; t = Pres} ; TPast = {s = [] ; t = Past} ; TFut = {s = [] ; t = Fut} ; - TCond = {s = [] ; t = Perf} ; + TCond = {s = [] ; t = Cond} ; ASimul = {s = [] ; a = Simul} ; AAnter = {s = [] ; a = Anter} ; @@ -116,53 +117,53 @@ lin PNeg = {s = [] ; p = Neg} ; UseV a t p _ v = { - v = tenseV (a.s ++ t.s) t.t a.a Act v ; - inf = tenseInfV a.s a.a Act 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 ; adj = noObj ; obj1 = ; ---- not used, just default value obj2 = ; - adV = p.s ++ neg p.p ; + adV = negAdV p ; adv = [] ; ext = [] ; } ; PassUseV a t p _ v = { - v = tenseV (a.s ++ t.s) t.t a.a Pass v ; - inf = tenseInfV a.s a.a Pass 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 ; 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 = p.s ++ neg p.p ; + adV = negAdV p ; adv = [] ; ext = [] ; } ; AgentPassUseV a t p _ v np = { - v = tenseV (a.s ++ t.s) t.t a.a Pass v ; - inf = tenseInfV a.s a.a Pass 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 ; adj = \\a => [] ; obj1 = ; obj2 = ; - adV = p.s ++ neg p.p ; + adV = negAdV p ; adv = appComplCase agentCase np ; ---- add a specific field for agent? ext = [] ; } ; UseAP a t p _ ap = { - v = tenseV (a.s ++ t.s) t.t a.a Act be_V ; - inf = tenseInfV a.s a.a Act be_V ; + v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr be_V ; + inf = tenseInfV a.s a.a p.p Act be_V ; c1 = ap.c1 ; c2 = ap.c2 ; adj = \\a => ap.s ! a ; obj1 = ; obj2 = ; --- there are no A3's - adV = p.s ++ neg p.p ; + adV = negAdV p ; adv = [] ; ext = [] ; } ; @@ -202,6 +203,7 @@ lin } ; PredVP x np vp = vp ** { + v = vp.v ! np.a ; subj = np.s ! Nom ; adj = vp.adj ! np.a ; obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase @@ -225,6 +227,7 @@ lin QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför älskar hon oss QuestVP x ip vp = vp ** { + v = vp.v ! ip.a ; foc = ip.s ; -- vem älskar henne focType = FocSubj ; subj = [] ; @@ -284,10 +287,12 @@ lin StartVPC c x v w = { ---- some loss of quality seems inevitable v = \\a => - v.v.p1 ++ v.adV ++ v.v.p2 ++ v.v.p3 ++ v.adj ! a ++ + let vv = v.v ! a ; wv = w.v ! a + in + vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! a ++ v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase ++ c.s ++ - w.v.p1 ++ w.adV ++ w.v.p2 ++ w.v.p3 ++ w.adj ! a ++ ---- appComplCase + wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! a ++ ---- appComplCase 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) ; @@ -296,7 +301,7 @@ lin } ; UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable - v = <[], [], vpc.v ! defaultAgr> ; ---- agreement + v = \\a => <[], [], vpc.v ! a> ; inf = <[], vpc.inf ! defaultAgr> ; ---- agreement c1 = vpc.c1 ; c2 = vpc.c2 ; @@ -337,7 +342,7 @@ oper be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ; - neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ; + negAdV : Pol -> Str = \p -> p.s ; reflPron : Agr -> Str = \a -> case a of {Sg => "herself" ; Pl => "us"} ; @@ -348,31 +353,48 @@ oper vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ; - tenseV : Str -> STense -> Anteriority -> Voice -> V -> Str * Str * Str = \sta,t,a,o,v -> case o of { --- sta dummy s field of Ant and Tense - Act => tenseActV sta t a v ; - Pass => tensePassV sta t a v + tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> Agr -> V -> 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 + } ; + + tenseActV : Str -> STense -> Anteriority -> Polarity -> Agr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> + let vt = case of { + => VPres ; + => VPast ; + _ => VInf + } + in + case of { + => + case v.isAux of { + True => ; + False => case p of { + Pos => <[], sta ++ v.v ! vt, []> ; + Neg => + | + } + } ; + => + | ; + => + | ; + => + | } ; - tenseActV : Str -> STense -> Anteriority -> V -> Str * Str * Str = \sta,t,a,v -> case of { --- sta dummy s field of Ant and Tense - => ; - => ; - => ; - => ; - => ; - => ; - => ; - => - } ; - tensePassV : Str -> STense -> Anteriority -> V -> Str * Str * Str = \sta,t,a,v -> + + tensePassV : Str -> STense -> Anteriority -> Polarity -> Agr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> let - be = tenseActV sta t a be_V ; + be = tenseActV sta t a p agr be_V ; done = v.v ! VPastPart in ; - tenseInfV : Str -> Anteriority -> Voice -> V -> Str * Str = \sa,a,o,v -> + tenseInfV : Str -> Anteriority -> Polarity -> Voice -> V -> Str * Str = \sa,a,p,o,v -> case a of { - Simul => <[], sa ++ v.v ! VInf> ; -- hon vill sova - Anter => -- hon vill (ha) sovit + Simul => <[], sa ++ v.v ! VInf> ; -- hon vill sova + Anter => -- hon vill (ha) sovit } ; @@ -479,12 +501,31 @@ oper edV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ed" ; ingV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ing" ; - do_V : V = lin V {v = mkVerb "do" "does" "did" "done" "doing" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ; + will_Aux : VForm -> Polarity -> Str = \vf,p -> case of { + => "will" ; + => "won't" ; + => "would" ; + => "wouldn't" + } ; - have_V : V = lin V {v = mkVerb "have" "has" "had" "had" "having" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ; - - will_V : V = lin V {v = mkVerb "will" "will" "would" "would" "will" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ; + have_Aux : VForm -> Polarity -> Str = \vf,p -> case of { + => "have" ; + => "haven't" ; + => "has" ; + => "hasn't" ; + => "had" ; + => "hadn't" + } ; + do_Aux : VForm -> Polarity -> Str = \vf,p -> case of { + => "do" ; + => "don't" ; + => "does" ; + => "doesn't" ; + => "did" ; + => "didn't" + } ; + not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ; } \ No newline at end of file