msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

VP coordination, focus in QCl in Predication. Swe is close to correct but in Eng details with auxiliaries have to be fixed.

Browse Source
This commit is contained in:
aarne
2014-01-24 13:57:44 +00:00
parent 39a0d9b668
commit 42a28523c0
3 changed files with 221 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -7,33 +7,37 @@ cat
Arg ; Arg ;
V Arg ; V Arg ;
VP Arg ; VP Arg ;
VPC Arg ; -- conjunction of VP
Temp ; Temp ;
Pol ; Pol ;
Cl Arg ; Cl Arg ;
QCl Arg ;
NP ; NP ;
Adv ; Adv ;
AdV ; AdV ;
S ; S ;
QS ;
Utt ; Utt ;
AP Arg ; AP Arg ;
IP ; IP ;
Prep ; Prep ;
Conj ;
fun fun
aNone, aS, aV : Arg ; aNone, aS, aV, aQ, aA : Arg ;
aNP : Arg -> Arg ; aNP : Arg -> Arg ;
TPres, TPast : Temp ; TPres, TPast : 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 ;
SlashVNP : (a : Arg) -> VP (aNP a) -> NP -> VP a ; -- consuming first NP 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 SlashVNP2 : (a : Arg) -> VP (aNP (aNP a)) -> NP -> VP (aNP a) ; -- consuming second NP
ComplVS : (a : Arg) -> VP aS -> Cl a -> VP a ; ComplVS : (a : Arg) -> VP aS -> Cl a -> VP a ;
ComplVV : (a : Arg) -> VP aV -> VP 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 ComplVQ : (a : Arg) -> VP aQ -> QCl a -> VP a ;
SlashV2V : (a : Arg) -> VP (aNP aV) -> VP a -> VP (aNP 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 ; 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) 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 : IP -> VP aNone -> QS ; ---- TODO: QS a QuestVP : (a : Arg) -> IP -> VP a -> QCl a ;
QuestSlash : IP -> Cl (aNP aNone) -> QS ; QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ;
QuestCl : (a : Arg) -> Cl a -> QCl a ;
DeclCl : Cl aNone -> S ; UseCl : Cl aNone -> S ;
QuestCl : Cl aNone -> QS ; UseQCl : QCl aNone -> S ; -- deprecate QS
UttS : S -> Utt ; 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 ; sleep_V : V aNone ;
walk_V : V aNone ;
love_V2 : V (aNP aNone) ; love_V2 : V (aNP aNone) ;
look_V2 : V (aNP aNone) ;
believe_VS : V aS ; believe_VS : V aS ;
tell_V2S : V (aNP aS) ; tell_V2S : V (aNP aS) ;
prefer_V3 : V (aNP (aNP aNone)) ; prefer_V3 : V (aNP (aNP aNone)) ;
want_VV : V aV ; want_VV : V aV ;
force_V2V : V (aNP aV) ; force_V2V : V (aNP aV) ;
wonder_VQ : V aQ ;
old_A : AP aNone ; old_A : AP aNone ;
married_A2 : AP (aNP aNone) ; -- married to her married_A2 : AP (aNP aNone) ; -- married to her
@@ -80,4 +93,6 @@ fun
with_Prep : Prep ; with_Prep : Prep ;
and_Conj : Conj ;
} }

107
lib/src/experimental/PredicationEng.gf
View File

@@ -1,4 +1,4 @@
concrete PredicationEng of Predication = { concrete PredicationEng of Predication = open Prelude in {
param param
Agr = Sg | Pl ; Agr = Sg | Pl ;
@@ -37,17 +37,37 @@ lincat
c3 : Str 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} ; 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} ;
Adv = {s : Str} ; Adv = {s : Str} ;
AdV = {s : Str} ; AdV = {s : Str} ;
S = {s : Str} ; S = {s : Str} ;
QS = {s : Str} ;
Utt = {s : Str} ; Utt = {s : Str} ;
AP = {s : Str ; c1 : Str ; c2 : Str ; obj1 : Agr => Str} ; AP = {s : Str ; c1 : Str ; c2 : Str ; obj1 : Agr => Str} ;
IP = {s : Str ; a : Agr} ; IP = {s : Str ; a : Agr} ;
Prep = {s : Str} ; Prep = {s : Str} ;
Conj = {s : Str} ;
lin lin
aNone, aS, aV = {s = []} ; aNone, aS, aV = {s = []} ;
@@ -116,7 +136,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)).s ; ext = declCl (lin Cl cl) ;
} ; } ;
ComplVV x vp vpo = { ComplVV x vp vpo = {
@@ -142,7 +162,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)).s ; ext = declCl (lin Cl cl) ;
} ; } ;
SlashV2V x vp vpo = { SlashV2V x vp vpo = {
@@ -237,27 +257,76 @@ lin
} ; } ;
DeclCl cl = { QuestCl x cl = cl ** {foc = [] ; hasFoc = False} ; -- verb first: älskar hon oss
s = cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ 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 ! 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 = { QuestSlash x ip cl =
s = cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext let
ips = cl.c3 ++ ip.s ; ---- c3?
focobj = case cl.hasFoc of {
True => <[],ips> ;
False => <ips,[]>
} ;
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 = { UseCl cl = {s = declCl cl} ;
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 UseQCl cl = {s = questCl cl} ;
} ;
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
} ;
UttS s = s ; 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 => <do_Aux Pres a, 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" ; sleep_V = mkV "sleep" ;
walk_V = mkV "walk" ;
love_V2 = mkV "love" ; love_V2 = mkV "love" ;
look_V2 = mkV "look" "at" [] ;
believe_VS = mkV "believe" ; believe_VS = mkV "believe" ;
tell_V2S = mkV "tell" ; tell_V2S = mkV "tell" ;
prefer_V3 = mkV "prefer" [] "to" ; prefer_V3 = mkV "prefer" [] "to" ;
@@ -281,6 +350,8 @@ lin
with_Prep = {s = "with"} ; with_Prep = {s = "with"} ;
and_Conj = {s = "and"} ;
oper oper
mkV = overload { mkV = overload {
mkV : Str -> V = \s -> lin V {v = \\_,_ => s ; c1 = [] ; c2 = []} ; 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 ; 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 ;
} }

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

@@ -1,4 +1,4 @@
concrete PredicationSwe of Predication = { concrete PredicationSwe of Predication = open Prelude in {
param param
Agr = Sg | Pl ; Agr = Sg | Pl ;
@@ -38,17 +38,37 @@ lincat
c3 : Str 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} ; 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} ;
Adv = {s : Str} ; Adv = {s : Str} ;
AdV = {s : Str} ; AdV = {s : Str} ;
S = {s : Str} ; S = {s : Str} ;
QS = {s : Str} ;
Utt = {s : Str} ; Utt = {s : Str} ;
AP = {s : Agr => Str ; c1 : Str ; c2 : Str ; obj1 : Agr => Str} ; AP = {s : Agr => Str ; c1 : Str ; c2 : Str ; obj1 : Agr => Str} ;
IP = {s : Str ; a : Agr} ; IP = {s : Str ; a : Agr} ;
Prep = {s : Str} ; Prep = {s : Str} ;
Conj = {s : Str} ;
lin lin
aNone, aS, aV = {s = []} ; aNone, aS, aV = {s = []} ;
@@ -119,7 +139,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)).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 = { ComplVV x vp vpo = {
@@ -145,7 +178,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)).s ; ext = declCl (lin Cl cl) ;
} ; } ;
SlashV2V x vp vpo = { SlashV2V x vp vpo = {
@@ -239,33 +272,82 @@ 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
DeclCl cl = { QuestVP x ip vp = {
s = cl.subj ++ cl.v ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext 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 = { QuestSlash x ip cl =
s = cl.v ++ cl.subj ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext let
ips = cl.c3 ++ ip.s ; ---- c3?
focobj = case cl.hasFoc of {
True => <[],ips> ;
False => <ips,[]>
} ;
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 = { UseCl cl = {s = declCl cl} ;
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 UseQCl cl = {s = questCl cl} ;
} ;
QuestSlash ip cl = {
s = ip.s ++ cl.v ++ cl.subj ++ cl.adV ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3
} ;
UttS s = s ; 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" ; sleep_V = mkV "sova" "sover" "sov" ;
walk_V = mkV "gå" "går" "gick" ;
love_V2 = mkV "älska" "älskar" "älskade" ; love_V2 = mkV "älska" "älskar" "älskade" ;
look_V2 = mkV "titta" "tittar" "tittade" "på" [] ;
believe_VS = mkV "tro" "tror" "trodde" ; believe_VS = mkV "tro" "tror" "trodde" ;
tell_V2S = mkV "berätta" "berättar" "berättade" "för" [] ; tell_V2S = mkV "berätta" "berättar" "berättade" "för" [] ;
prefer_V3 = mkV "föredra" "föredrar" "föredrog" [] "framför" ; prefer_V3 = mkV "föredra" "föredrar" "föredrog" [] "framför" ;
want_VV = mkV "vilja" "vill" "ville" ; want_VV = mkV "vilja" "vill" "ville" ;
force_V2V = mkV "tvinga" "tvingar" "tvingade" [] "att" ; force_V2V = mkV "tvinga" "tvingar" "tvingade" [] "att" ;
wonder_VQ = mkV "undra" "undrar" "undrade" ;
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 = \\_ => []} ;
@@ -284,6 +366,8 @@ lin
with_Prep = {s = "med"} ; with_Prep = {s = "med"} ;
and_Conj = {s = "och"} ;
oper oper
mkV = overload { mkV = overload {
mkV : (x,y,z : Str) -> V = \x,y,z -> 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 ; 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 ;
} }