GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

compound tenses in PredicationSwe

Browse Source
This commit is contained in:
aarne
2014-01-25 17:35:24 +00:00
parent 4a245c1253
commit 11395b50f0
2 changed files with 158 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
lib/src/experimental/Predication.gf
View File

@@ -11,6 +11,7 @@ cat
Temp ; Temp ;
Pol ; Pol ;
Cl Arg ; Cl Arg ;
ClC Arg ; -- conjunction of Cl
QCl Arg ; QCl Arg ;
NP ; NP ;
Adv ; Adv ;
@@ -21,11 +22,12 @@ cat
IP ; IP ;
Prep ; Prep ;
Conj ; Conj ;
IAdv ;
fun fun
aNone, aS, aV, aQ, aA : Arg ; aNone, aS, aV, aQ, aA : Arg ;
aNP : Arg -> Arg ; aNP : Arg -> Arg ;
TPres, TPast : Temp ; TPres, TPast, TPerf, TFut : Temp ;
PPos, PNeg : Pol ; PPos, PNeg : Pol ;
UseV : Temp -> Pol -> (a : Arg) -> V a -> VP a ; UseV : Temp -> Pol -> (a : Arg) -> V a -> VP a ;
@@ -45,7 +47,8 @@ fun
PredVP : (a : Arg) -> NP -> VP a -> Cl a ; 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 ;
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) 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) ReflVP2 : (a : Arg) -> VP (aNP (aNP a)) -> VP (aNP a) ; -- refl on second position (indirect object)
QuestVP : (a : Arg) -> IP -> VP a -> QCl a ; QuestVP : (a : Arg) -> IP -> VP a -> QCl a ;
QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ; QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ;
QuestCl : (a : Arg) -> Cl a -> QCl a ; QuestCl : (a : Arg) -> Cl a -> QCl a ;
QuestIAdv : (a : Arg) -> IAdv -> Cl a -> QCl a ;
UseCl : Cl aNone -> S ; UseCl : Cl aNone -> S ;
UseQCl : QCl aNone -> S ; -- deprecate QS UseQCl : QCl aNone -> S ; -- deprecate QS
UttS : S -> Utt ; UttS : S -> Utt ;
-- VP coordination
StartVPC : Conj -> (a : Arg) -> VP a -> VP a -> VPC a ; StartVPC : Conj -> (a : Arg) -> VP a -> VP a -> VPC a ;
ContVPC : (a : Arg) -> VP a -> VPC a -> VPC a ; ContVPC : (a : Arg) -> VP a -> VPC a -> VPC a ;
UseVPC : (a : Arg) -> VPC a -> VP 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 -- lexicon
sleep_V : V aNone ; sleep_V : V aNone ;
@@ -101,4 +112,6 @@ fun
and_Conj : Conj ; and_Conj : Conj ;
why_IAdv : IAdv ;
} }

188
lib/src/experimental/PredicationSwe.gf
View File

@@ -3,9 +3,11 @@ concrete PredicationSwe of Predication = open Prelude in {
param param
Agr = Sg | Pl ; Agr = Sg | Pl ;
Case = Nom | Acc ; Case = Nom | Acc ;
Tense = Pres | Past ; Tense = Pres | Past | Perf | Fut ;
Polarity = Pos | Neg ; 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 oper
defaultAgr = Sg ; defaultAgr = Sg ;
@@ -21,7 +23,7 @@ lincat
} ; } ;
VP = { VP = {
v : Str ; v : Str * Str ;
inf : Str ; inf : Str ;
c1 : Str ; c1 : Str ;
c2 : Str ; c2 : Str ;
@@ -34,7 +36,7 @@ lincat
} ; } ;
Cl = { Cl = {
v : Str ; v : Str * Str ;
inf : Str ; inf : Str ;
adj,obj1,obj2 : Str ; adj,obj1,obj2 : Str ;
adv : Str ; adv : Str ;
@@ -45,7 +47,7 @@ lincat
} ; } ;
QCl = { QCl = {
v : Str ; v : Str * Str ;
inf : Str ; inf : Str ;
adj,obj1,obj2 : Str ; adj,obj1,obj2 : Str ;
adv : Str ; adv : Str ;
@@ -54,7 +56,7 @@ lincat
subj : Str ; subj : Str ;
c3 : Str ; c3 : Str ;
foc : Str ; -- the focal position at the beginning, e.g. *vem* älskar hon 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 = { VPC = {
@@ -64,6 +66,11 @@ lincat
c2 : Str c2 : Str
} ; } ;
ClC = {
s : Str ;
c3 : Str ; ---- which prep
} ;
Temp = {s : Str ; t : Tense} ; Temp = {s : Str ; t : Tense} ;
Pol = {s : Str ; p : Polarity} ; Pol = {s : Str ; p : Polarity} ;
NP = {s : Case => Str ; a : Agr} ; NP = {s : Case => Str ; a : Agr} ;
@@ -75,6 +82,7 @@ lincat
IP = {s : Str ; a : Agr} ; IP = {s : Str ; a : Agr} ;
Prep = {s : Str} ; Prep = {s : Str} ;
Conj = {s : Str} ; Conj = {s : Str} ;
IAdv = {s : Str} ;
lin lin
aNone, aS, aV, aA, aQ = {s = []} ; aNone, aS, aV, aA, aQ = {s = []} ;
@@ -82,12 +90,14 @@ lin
TPres = {s = [] ; t = Pres} ; TPres = {s = [] ; t = Pres} ;
TPast = {s = [] ; t = Past} ; TPast = {s = [] ; t = Past} ;
TPerf = {s = [] ; t = Perf} ;
TFut = {s = [] ; t = Fut} ;
PPos = {s = [] ; p = Pos} ; PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ; PNeg = {s = [] ; p = Neg} ;
UseV t p _ v = { UseV t p _ v = {
v = t.s ++ v.v ! VT t.t ; v = tenseV t.s t.t v ;
inf = t.s ++ aux t.t ++ v.v ! Inf ; inf = t.s ++ auxInf t.t v ;
c1 = v.c1 ; c1 = v.c1 ;
c2 = v.c2 ; c2 = v.c2 ;
adj = \\a => [] ; adj = \\a => [] ;
@@ -99,8 +109,8 @@ lin
} ; } ;
UseAP t p _ ap = { UseAP t p _ ap = {
v = t.s ++ be_Aux (VT t.t) ; v = tenseV t.s t.t be_V ;
inf = t.s ++ p.s ++ aux t.t ++ be_Aux Inf ; inf = t.s ++ p.s ++ auxInf t.t be_V ;
c1 = ap.c1 ; c1 = ap.c1 ;
c2 = ap.c2 ; c2 = ap.c2 ;
adj = \\a => ap.s ! a ; adj = \\a => ap.s ! a ;
@@ -147,7 +157,7 @@ lin
obj2 = vp.obj2 ; obj2 = vp.obj2 ;
adV = vp.adV ; adV = vp.adV ;
adv = vp.adv ; adv = vp.adv ;
ext = declCl (lin Cl cl) ; ext = that_Compl ++ declSubordCl (lin Cl cl) ;
} ; } ;
ComplVQ x vp qcl = { ComplVQ x vp qcl = {
@@ -160,7 +170,7 @@ lin
obj2 = vp.obj2 ; obj2 = vp.obj2 ;
adV = vp.adV ; adV = vp.adV ;
adv = vp.adv ; adv = vp.adv ;
ext = questCl qcl ; ext = questSubordCl qcl ;
} ; } ;
ComplVV x vp vpo = { ComplVV x vp vpo = {
@@ -199,7 +209,20 @@ lin
obj2 = vp.obj2 ; obj2 = vp.obj2 ;
adV = vp.adV ; adV = vp.adV ;
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 = { SlashV2V x vp vpo = {
@@ -215,6 +238,19 @@ lin
ext = vp.ext ; 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 = { AdvVP adv _ vp = {
v = vp.v ; v = vp.v ;
inf = vp.inf ; inf = vp.inf ;
@@ -293,11 +329,27 @@ lin
c3 = p.s ; -- for one more prep to build ClSlash 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 = { QuestVP x ip vp = {
foc = ip.s ; -- vem älskar henne foc = ip.s ; -- vem älskar henne
hasFoc = True ; focType = FocSubj ;
subj = [] ; subj = [] ;
v = vp.v ; v = vp.v ;
inf = vp.inf ; inf = vp.inf ;
@@ -313,13 +365,13 @@ lin
QuestSlash x ip cl = QuestSlash x ip cl =
let let
ips = cl.c3 ++ ip.s ; ---- c3? ips = cl.c3 ++ ip.s ; ---- c3?
focobj = case cl.hasFoc of { focobj = case cl.focType of {
True => <[],ips> ; NoFoc => <ips, [], FocObj> ; -- put ip object to focus
False => <ips,[]> t => <[], ips, t> -- put ip object in situ
} ; } ;
in { in {
foc = focobj.p1 ; foc = focobj.p1 ;
hasFoc = True ; focType = focobj.p3 ;
subj = cl.subj ; subj = cl.subj ;
v = cl.v ; v = cl.v ;
inf = cl.inf ; inf = cl.inf ;
@@ -339,9 +391,9 @@ lin
StartVPC c x v w = { ---- some loss of quality seems inevitable StartVPC c x v w = { ---- some loss of quality seems inevitable
v = \\a => 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 ++ ++ 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 => inf = \\a =>
infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ; infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ;
c1 = [] ; --- w.c1 ; --- the full story is to unify v and 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 UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
v = vpc.v ! Sg ; ---- agreement v = <[], vpc.v ! defaultAgr> ; ---- agreement
inf = vpc.inf ! Sg ; ---- agreement inf = vpc.inf ! defaultAgr ; ---- agreement
c1 = vpc.c1 ; c1 = vpc.c1 ;
c2 = vpc.c2 ; c2 = vpc.c2 ;
adj = \\a => [] ; adj = \\a => [] ;
@@ -360,22 +412,40 @@ lin
ext = [] ; 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" ; UseClC x cl = {
walk_V = mkV "gå" "går" "gick" ; subj = [] ;
love_V2 = mkV "älska" "älskar" "älskade" ; v = <[],cl.s> ; ----
look_V2 = mkV "titta" "tittar" "tittade" "på" [] ; inf = [] ;
believe_VS = mkV "tro" "tror" "trodde" ; adj = [] ;
tell_V2S = mkV "berätta" "berättar" "berättade" "för" [] ; obj1 = [] ;
prefer_V3 = mkV "föredra" "föredrar" "föredrog" [] "framför" ; obj2 = [] ;
want_VV = mkV "vilja" "vill" "ville" ; adV = [] ;
force_V2V = {v = table {Inf => "tvinga" ; VT Pres => "tvingar" ; VT Past => "tvingade"} ; 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} ; c1 = [] ; c2 = "att" ; isSubjectControl = False} ;
promise_V2V = mkV "lova" "lovar" "lovade" [] "att" ; promise_V2V = mkV "lova" "lovar" "lovade" "lovat" [] "att" ;
wonder_VQ = mkV "undra" "undrar" "undrade" ; wonder_VQ = mkV "undra" "undrar" "undrade" "undrat" ;
become_VA = mkV "bli" "blir" "blev" ; become_VA = mkV "bli" "blir" "blev" "blivit" ;
make_V2A = {v = table {Inf => "göra" ; VT Pres => "gör" ; VT Past => "gjorde"} ; make_V2A = {v = table {Inf => "göra" ; VPres => "gör" ; VPret => "gjorde" ; VSup => "gjort"} ;
c1 = [] ; c2 = [] ; isSubjectControl = False} ; 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 = \\_ => []} ; old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ; married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ;
@@ -396,23 +466,25 @@ lin
and_Conj = {s = "och"} ; and_Conj = {s = "och"} ;
why_IAdv = {s = "varför"} ;
oper oper
mkV = overload { mkV = overload {
mkV : (x,y,z : Str) -> V = \x,y,z -> mkV : (x,y,z,u : Str) -> V = \x,y,z,u ->
lin V {v = table {Inf => x ; VT Pres => y ; VT Past => z} ; c1 = [] ; c2 = [] ; isSubjectControl = True} ; lin V {v = table {Inf => x ; VPres => y ; VPret => z ; VSup => u} ; c1 = [] ; c2 = [] ; isSubjectControl = True} ;
mkV : (x,y,z : Str) -> Str -> Str -> V = \x,y,z,p,q -> mkV : (x,y,z,u : Str) -> Str -> Str -> V = \x,y,z,u,p,q ->
lin V {v = table {Inf => x ; VT Pres => y ; VT Past => z} ; c1 = p ; c2 = q ; isSubjectControl = True} ; 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 { be_V : V = mkV "vara" "är" "var" "varit" ;
Inf => "vara" ;
VT Pres => "är" ; have_V : V = mkV "ha" "har" "hade" "haft" ;
VT Past => "var"
} ; shall_V : V = mkV "skola" "ska" "skulle" "skolat" ;
neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ; 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"} ; 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 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 ; 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 ; tenseV : Str -> Tense -> V -> Str * Str = \s,t,v -> case t of { --- s : Str is the dummy s field of Temp
questCl : QCl -> Str = \cl -> cl.foc ++ cl.v ++ cl.subj ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ; Pres => <s ++ v.v ! VPres, []> ;
Past => <s ++ v.v ! VPret, []> ;
Perf => <have_V.v ! VPres, s ++ v.v ! VSup> ;
Fut => <shall_V.v ! VPres, s ++ v.v ! Inf>
} ;
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" | [] ;
} }