diff --git a/lib/src/experimental/Predication.gf b/lib/src/experimental/Predication.gf index 107c78e79..87c3a248b 100644 --- a/lib/src/experimental/Predication.gf +++ b/lib/src/experimental/Predication.gf @@ -7,33 +7,37 @@ cat Arg ; V Arg ; VP Arg ; + VPC Arg ; -- conjunction of VP Temp ; Pol ; Cl Arg ; + QCl Arg ; NP ; Adv ; AdV ; S ; - QS ; Utt ; AP Arg ; IP ; Prep ; + Conj ; fun - aNone, aS, aV : Arg ; + aNone, aS, aV, aQ, aA : Arg ; aNP : Arg -> Arg ; TPres, TPast : Temp ; PPos, PNeg : Pol ; UseV : Temp -> Pol -> (a : Arg) -> V a -> VP a ; - SlashVNP : (a : Arg) -> VP (aNP a) -> NP -> VP a ; -- consuming first NP - SlashVNP2 : (a : Arg) -> VP (aNP (aNP a)) -> NP -> VP (aNP a) ; -- consuming second NP - ComplVS : (a : Arg) -> VP aS -> Cl a -> VP a ; - ComplVV : (a : Arg) -> VP aV -> VP a -> VP a ; - SlashV2S : (a : Arg) -> VP (aNP aS) -> Cl a -> VP (aNP a) ; -- a:Arg gives slash propagation, SlashVS - SlashV2V : (a : Arg) -> VP (aNP aV) -> VP a -> VP (aNP a) ; + SlashVNP : (a : Arg) -> VP (aNP a) -> NP -> VP a ; -- consuming first NP + SlashVNP2 : (a : Arg) -> VP (aNP (aNP a)) -> NP -> VP (aNP a) ; -- consuming second NP + ComplVS : (a : Arg) -> VP aS -> Cl a -> VP a ; + ComplVV : (a : Arg) -> VP aV -> VP a -> VP a ; + ComplVQ : (a : Arg) -> VP aQ -> QCl a -> VP a ; + ComplVA : (a : Arg) -> VP aA -> AP a -> VP a ; + SlashV2S : (a : Arg) -> VP (aNP aS) -> Cl a -> VP (aNP a) ; -- a:Arg gives slash propagation, SlashVS + SlashV2V : (a : Arg) -> VP (aNP aV) -> VP a -> VP (aNP a) ; UseAP : Temp -> Pol -> (a : Arg) -> AP a -> VP a ; @@ -47,22 +51,31 @@ 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 : IP -> VP aNone -> QS ; ---- TODO: QS a - QuestSlash : IP -> Cl (aNP aNone) -> QS ; + QuestVP : (a : Arg) -> IP -> VP a -> QCl a ; + QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ; + QuestCl : (a : Arg) -> Cl a -> QCl a ; - DeclCl : Cl aNone -> S ; - QuestCl : Cl aNone -> QS ; + UseCl : Cl aNone -> S ; + UseQCl : QCl aNone -> S ; -- deprecate QS UttS : S -> Utt ; - UttQS : QS -> Utt ; + + 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 ; + +-- lexicon sleep_V : V aNone ; + walk_V : V aNone ; love_V2 : V (aNP aNone) ; + look_V2 : V (aNP aNone) ; believe_VS : V aS ; tell_V2S : V (aNP aS) ; prefer_V3 : V (aNP (aNP aNone)) ; want_VV : V aV ; force_V2V : V (aNP aV) ; + wonder_VQ : V aQ ; old_A : AP aNone ; married_A2 : AP (aNP aNone) ; -- married to her @@ -80,4 +93,6 @@ fun with_Prep : Prep ; + and_Conj : Conj ; + } \ No newline at end of file diff --git a/lib/src/experimental/PredicationEng.gf b/lib/src/experimental/PredicationEng.gf index 823b82981..adf3cce7d 100644 --- a/lib/src/experimental/PredicationEng.gf +++ b/lib/src/experimental/PredicationEng.gf @@ -1,4 +1,4 @@ -concrete PredicationEng of Predication = { +concrete PredicationEng of Predication = open Prelude in { param Agr = Sg | Pl ; @@ -37,17 +37,37 @@ lincat c3 : Str } ; + QCl = { + v : Str * Str ; + inf : Str ; + adj,obj1,obj2 : Str ; + adv : Str ; + adV : Str ; + ext : Str ; + 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* + } ; + + VPC = { + v : Agr => Str ; + inf : Agr => Str ; + c1 : Str ; + c2 : Str + } ; + Temp = {s : Str ; t : Tense} ; Pol = {s : Str ; p : Polarity} ; NP = {s : Case => Str ; a : Agr} ; Adv = {s : Str} ; AdV = {s : Str} ; S = {s : Str} ; - QS = {s : Str} ; Utt = {s : Str} ; AP = {s : Str ; c1 : Str ; c2 : Str ; obj1 : Agr => Str} ; IP = {s : Str ; a : Agr} ; Prep = {s : Str} ; + Conj = {s : Str} ; lin aNone, aS, aV = {s = []} ; @@ -116,7 +136,7 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = (DeclCl (lin Cl cl)).s ; + ext = declCl (lin Cl cl) ; } ; ComplVV x vp vpo = { @@ -142,7 +162,7 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = (DeclCl (lin Cl cl)).s ; + ext = declCl (lin Cl cl) ; } ; SlashV2V x vp vpo = { @@ -237,27 +257,76 @@ lin } ; - DeclCl cl = { - s = cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext + QuestCl x cl = cl ** {foc = [] ; hasFoc = False} ; -- verb first: älskar hon oss + + QuestVP x ip vp = { + foc = ip.s ; -- vem älskar henne + hasFoc = True ; + subj = [] ; + v = vp.v ! ip.a ; + inf = vp.inf ; + adj = vp.adj ! ip.a ; + obj1 = vp.c1 ++ vp.obj1 ! ip.a ; + obj2 = vp.c2 ++ vp.obj2 ! ip.a ; + adV = vp.adV ; + adv = vp.adv ; + ext = vp.ext ; + c3 = [] ; -- for one more prep to build ClSlash } ; - QuestCl cl = { - s = cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext + QuestSlash x ip cl = + let + ips = cl.c3 ++ ip.s ; ---- c3? + focobj = case cl.hasFoc of { + True => <[],ips> ; + False => + } ; + in { + foc = focobj.p1 ; + hasFoc = True ; + subj = cl.subj ; + v = cl.v ; + inf = cl.inf ; + adj = cl.adj ; + obj1 = cl.obj1 ++ focobj.p2 ; + obj2 = cl.obj2 ; ---- slash to this part? + adV = cl.adV ; + adv = cl.adv ; + ext = cl.ext ; + c3 = [] ; } ; - QuestVP ip vp = { - s = ip.s ++ (vp.v ! ip.a).p1 ++ vp.adV ++ (vp.v ! ip.a).p2 ++ vp.adj ! ip.a ++ vp.c1 ++ vp.obj1 ! ip.a ++ vp.c2 ++ vp.obj2 ! ip.a ++ vp.adv ++ vp.ext - } ; - - QuestSlash ip cl = { - s = ip.s ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 - } ; + UseCl cl = {s = declCl cl} ; + UseQCl cl = {s = questCl cl} ; UttS s = s ; - UttQS s = s ; + + StartVPC c x v w = { + v = \\a => + (v.v ! a).p1 ++ v.adV ++ (v.v ! a).p2 ++ v.adj ! a ++ v.c1 ++ v.obj1 ! a ++ v.c2 ++ v.obj2 ! a ++ v.adv ++ v.ext + ++ c.s ++ + (w.v ! a).p1 ++ w.adV ++ (w.v ! a).p2 ++ w.adj ! a ++ w.c1 ++ w.obj1 ! a ++ w.c2 ++ w.obj2 ! 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... + c2 = w.c2 ; + } ; + + UseVPC x vpc = { + v = \\a => ; ---- there is no uniform tense + inf = vpc.inf ! Sg ; ---- agreement + c1 = vpc.c1 ; + c2 = vpc.c2 ; + adj,obj1,obj2 = \\a => [] ; + adv,adV = [] ; + ext = [] ; + } ; + sleep_V = mkV "sleep" ; + walk_V = mkV "walk" ; love_V2 = mkV "love" ; + look_V2 = mkV "look" "at" [] ; believe_VS = mkV "believe" ; tell_V2S = mkV "tell" ; prefer_V3 = mkV "prefer" [] "to" ; @@ -281,6 +350,8 @@ lin with_Prep = {s = "with"} ; + and_Conj = {s = "and"} ; + oper mkV = overload { mkV : Str -> V = \s -> lin V {v = \\_,_ => s ; c1 = [] ; c2 = []} ; @@ -308,4 +379,8 @@ oper infVP : Agr -> VP -> Str = \a,vp -> vp.adV ++ vp.inf ++ vp.adj ! a ++ vp.c1 ++ vp.obj1 ! a ++ vp.c2 ++ vp.obj2 ! a ++ vp.adv ++ vp.ext ; + declCl : Cl -> Str = \cl ->cl.subj ++ cl.v.p1 ++ 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 ; + } \ No newline at end of file diff --git a/lib/src/experimental/PredicationSwe.gf b/lib/src/experimental/PredicationSwe.gf index d3678b11c..83b19a206 100644 --- a/lib/src/experimental/PredicationSwe.gf +++ b/lib/src/experimental/PredicationSwe.gf @@ -1,4 +1,4 @@ -concrete PredicationSwe of Predication = { +concrete PredicationSwe of Predication = open Prelude in { param Agr = Sg | Pl ; @@ -38,17 +38,37 @@ lincat c3 : Str } ; + QCl = { + v : Str ; + inf : Str ; + adj,obj1,obj2 : Str ; + adv : Str ; + adV : Str ; + ext : Str ; + 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* + } ; + + VPC = { + v : Agr => Str ; + inf : Agr => Str ; + c1 : Str ; + c2 : Str + } ; + Temp = {s : Str ; t : Tense} ; Pol = {s : Str ; p : Polarity} ; NP = {s : Case => Str ; a : Agr} ; Adv = {s : Str} ; AdV = {s : Str} ; S = {s : Str} ; - QS = {s : Str} ; Utt = {s : Str} ; AP = {s : Agr => Str ; c1 : Str ; c2 : Str ; obj1 : Agr => Str} ; IP = {s : Str ; a : Agr} ; Prep = {s : Str} ; + Conj = {s : Str} ; lin aNone, aS, aV = {s = []} ; @@ -119,7 +139,20 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = (DeclCl (lin Cl cl)).s ; + ext = declCl (lin Cl cl) ; + } ; + + ComplVQ x vp qcl = { + 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 = questCl qcl ; } ; ComplVV x vp vpo = { @@ -145,7 +178,7 @@ lin obj2 = vp.obj2 ; adV = vp.adV ; adv = vp.adv ; - ext = (DeclCl (lin Cl cl)).s ; + ext = declCl (lin Cl cl) ; } ; SlashV2V x vp vpo = { @@ -239,33 +272,82 @@ lin c3 = p.s ; -- for one more prep to build ClSlash } ; + QuestCl x cl = cl ** {foc = [] ; hasFoc = False} ; -- verb first: älskar hon oss - DeclCl cl = { - s = cl.subj ++ cl.v ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext + QuestVP x ip vp = { + foc = ip.s ; -- vem älskar henne + hasFoc = True ; + subj = [] ; + v = vp.v ; + inf = vp.inf ; + adj = vp.adj ! ip.a ; + obj1 = vp.c1 ++ vp.obj1 ! ip.a ; + obj2 = vp.c2 ++ vp.obj2 ! ip.a ; + adV = vp.adV ; + adv = vp.adv ; + ext = vp.ext ; + c3 = [] ; -- for one more prep to build ClSlash } ; - QuestCl cl = { - s = cl.v ++ cl.subj ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext + QuestSlash x ip cl = + let + ips = cl.c3 ++ ip.s ; ---- c3? + focobj = case cl.hasFoc of { + True => <[],ips> ; + False => + } ; + in { + foc = focobj.p1 ; + hasFoc = True ; + subj = cl.subj ; + v = cl.v ; + inf = cl.inf ; + adj = cl.adj ; + obj1 = cl.obj1 ++ focobj.p2 ; + obj2 = cl.obj2 ; ---- slash to this part? + adV = cl.adV ; + adv = cl.adv ; + ext = cl.ext ; + c3 = [] ; } ; - QuestVP ip vp = { - s = ip.s ++ vp.v ++ vp.adV ++ vp.adj ! ip.a ++ vp.c1 ++ vp.obj1 ! ip.a ++ vp.c2 ++ vp.obj2 ! ip.a ++ vp.adv ++ vp.ext - } ; - - QuestSlash ip cl = { - s = ip.s ++ cl.v ++ cl.subj ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 - } ; + UseCl cl = {s = declCl cl} ; + UseQCl cl = {s = questCl cl} ; UttS s = s ; - UttQS s = s ; + + StartVPC c x v w = { + v = \\a => + v.v ++ v.adV ++ v.adj ! a ++ v.c1 ++ v.obj1 ! a ++ v.c2 ++ v.obj2 ! a ++ v.adv ++ v.ext + ++ c.s ++ + w.v ++ w.adV ++ w.adj ! a ++ w.c1 ++ w.obj1 ! a ++ w.c2 ++ w.obj2 ! 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... + c2 = [] ; --- w.c2 ; + } ; + + UseVPC x vpc = { + v = vpc.v ! Sg ; ---- agreement + inf = vpc.inf ! Sg ; ---- agreement + c1 = vpc.c1 ; + c2 = vpc.c2 ; + adj,obj1,obj2 = \\a => [] ; + adv,adV = [] ; + ext = [] ; + } ; + 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 = mkV "tvinga" "tvingar" "tvingade" [] "att" ; + wonder_VQ = mkV "undra" "undrar" "undrade" ; old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ; married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ; @@ -284,6 +366,8 @@ lin with_Prep = {s = "med"} ; + and_Conj = {s = "och"} ; + oper mkV = overload { mkV : (x,y,z : Str) -> V = \x,y,z -> @@ -306,4 +390,6 @@ oper infVP : Agr -> VP -> Str = \a,vp -> vp.adV ++ vp.inf ++ vp.adj ! a ++ vp.c1 ++ vp.obj1 ! a ++ vp.c2 ++ vp.obj2 ! a ++ 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 ; } \ No newline at end of file