GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 09:52:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

experimental Predication with dependent types - promising, but far from finished

Browse Source
This commit is contained in:
aarne
2014-01-23 16:12:28 +00:00
parent caacaa9d8b
commit 8c1128c16c
2 changed files with 315 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
lib/src/experimental/Predication.gf Normal file
View File

@@ -0,0 +1,74 @@
abstract Predication = {
flags
startcat = Utt ;
cat
Arg ;
V Arg ;
VP Arg ;
Temp ;
Pol ;
Cl Arg ;
NP ;
Adv ;
S ;
QS ;
Utt ;
AP Arg ;
IP ;
fun
aNone, aS, aV : 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 : VP aS -> S -> VP aNone ;
ComplVV : VP aV -> VP aNone -> VP aNone ;
SlashV2S : VP (aNP aS) -> S -> VP (aNP aNone) ;
SlashV2V : VP (aNP aV) -> VP aNone -> VP (aNP aNone) ;
UseAP : Temp -> Pol -> (a : Arg) -> AP a -> VP a ;
PredVP : (a : Arg) -> NP -> VP a -> Cl a ;
AdvVP : Adv -> (a : Arg) -> VP a -> VP a ;
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 ;
DeclCl : Cl aNone -> S ;
QuestCl : Cl aNone -> QS ;
UttS : S -> Utt ;
UttQS : QS -> Utt ;
sleep_V : V aNone ;
love_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) ;
old_A : AP aNone ;
married_A2 : AP (aNP aNone) ; -- married to her
eager_AV : AP aV ; -- eager to sleep
easy_A2V : AP (aNP aV) ; -- easy for him to sleep
she_NP : NP ;
we_NP : NP ;
today_Adv : Adv ;
who_IP : IP ;
}

241
lib/src/experimental/PredicationEng.gf Normal file
View File

@@ -0,0 +1,241 @@
concrete PredicationEng of Predication = {
param
Agr = Sg | Pl ;
Case = Nom | Acc ;
Tense = Pres | Past ;
Polarity = Pos | Neg ;
lincat
Arg = {s : Str} ;
V = {v : Tense => Agr => Str ; c1 : Str ; c2 : Str} ;
VP = {v : Agr => Str * Str ; inf : Str ; c1 : Str ; c2 : Str ; adj,obj1,obj2 : Agr => Str ; adv : Str ; ext : Str} ;
Cl = {v : Str * Str ; inf : Str ; adj,obj1,obj2 : Str ; adv : Str ; ext : Str ; subj : Str} ;
Temp = {s : Str ; t : Tense} ;
Pol = {s : Str ; p : Polarity} ;
NP = {s : Case => Str ; a : Agr} ;
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} ;
lin
aNone, aS, aV = {s = []} ;
aNP a = a ;
TPres = {s = [] ; t = Pres} ;
TPast = {s = [] ; t = Past} ;
PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ;
UseV t p _ v = {
v = \\a => <t.s ++ p.s ++ do_Aux t.t a, p.s ++ neg p.p ++ v.v ! Pres ! Pl> ; ---- always with "do"
inf = t.s ++ p.s ++ neg p.p ++ aux t.t ++ v.v ! Pres ! Pl ;
c1 = v.c1 ;
c2 = v.c2 ;
adj,obj1,obj2 = \\a => [] ;
adv = [] ;
ext = [] ;
} ;
UseAP t p _ ap = {
v = \\a => <t.s ++ be_Aux t.t a, p.s ++ neg p.p> ; ---- always with "do"
inf = t.s ++ p.s ++ neg p.p ++ aux t.t ++ "be" ;
c1 = ap.c1 ;
c2 = ap.c2 ;
adj = \\_ => ap.s ;
obj1 = ap.obj1 ;
obj2 = \\a => [] ;
adv = [] ;
ext = [] ;
} ;
SlashVNP x vp np = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = \\a => np.s ! Acc ;
obj2 = vp.obj2 ;
adv = vp.adv ;
ext = vp.ext ;
} ;
SlashVNP2 x vp np = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = \\a => np.s ! Acc ;
adv = vp.adv ;
ext = vp.ext ;
} ;
ComplVS vp s = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = vp.obj2 ;
adv = vp.adv ;
ext = s.s ;
} ;
ComplVV vp vpo = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = \\a => infVP a vpo ;
adv = vp.adv ;
ext = vp.ext ;
} ;
SlashV2S vp s = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = vp.obj2 ;
adv = vp.adv ;
ext = s.s ;
} ;
SlashV2V vp vpo = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = \\a => infVP a vpo ;
adv = vp.adv ;
ext = vp.ext ;
} ;
AdvVP adv _ vp = {
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.s ;
ext = vp.ext ;
} ;
ReflVP x vp = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = \\a => reflPron a ;
obj2 = vp.obj2 ;
adv = vp.adv ;
ext = vp.ext ;
} ;
ReflVP2 x vp = {
v = vp.v ;
inf = vp.inf ;
c1 = vp.c1 ;
c2 = vp.c2 ;
adj = vp.adj ;
obj1 = vp.obj1 ;
obj2 = \\a => reflPron a ;
adv = vp.adv ;
ext = vp.ext ;
} ;
PredVP x np vp = {
subj = np.s ! Nom ;
v = vp.v ! np.a ;
inf = vp.inf ;
adj = vp.adj ! np.a ;
obj1 = vp.c1 ++ vp.obj1 ! np.a ;
obj2 = vp.c2 ++ vp.obj2 ! np.a ;
adv = vp.adv ;
ext = vp.ext ;
} ;
DeclCl cl = {
s = cl.subj ++ cl.v.p1 ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext
} ;
QuestCl cl = {
s = cl.v.p1 ++ cl.subj ++ cl.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext
} ;
QuestVP ip vp = {
s = ip.s ++ (vp.v ! ip.a).p1 ++ (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.v.p2 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext
} ;
UttS s = s ;
UttQS s = s ;
sleep_V = mkV "sleep" ;
love_V2 = mkV "love" ;
believe_VS = mkV "believe" ;
tell_V2S = mkV "tell" ;
prefer_V3 = mkV "prefer" [] "to" ;
want_VV = mkV "want" [] "to" ;
force_V2V = mkV "force" [] "to" ;
old_A = {s = "old" ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
married_A2 = {s = "married" ; c1 = "to" ; c2 = [] ; obj1 = \\_ => []} ;
eager_AV = {s = "eager" ; c1 = [] ; c2 = "to" ; obj1 = \\_ => []} ;
easy_A2V = {s = "easy" ; c1 = "for" ; c2 = "to" ; obj1 = \\_ => []} ;
she_NP = {s = table {Nom => "she" ; Acc => "her"} ; a = Sg} ;
we_NP = {s = table {Nom => "we" ; Acc => "us"} ; a = Pl} ;
today_Adv = {s = "today"} ;
who_IP = {s = "who" ; a = Sg} ;
oper
mkV = overload {
mkV : Str -> V = \s -> lin V {v = \\_,_ => s ; c1 = [] ; c2 = []} ;
mkV : Str -> Str -> Str -> V = \s,p,q -> lin V {v = \\_,_ => s ; c1 = p ; c2 = q} ;
} ;
do_Aux : Tense -> Agr -> Str = \t,a -> case <t,a> of {
<Pres,Sg> => "does" ;
<Pres,Pl> => "do" ;
<Past,_> => "did"
} ;
be_Aux : Tense -> Agr -> Str = \t,a -> case <t,a> of {
<Pres,Sg> => "is" ;
<Pres,Pl> => "are" ;
<Past,Sg> => "was" ;
<Past,Pl> => "were"
} ;
neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ;
aux : Tense -> Str = \t -> case t of {Pres => [] ; Past => "have"} ;
reflPron : Agr -> Str = \a -> case a of {Sg => "herself" ; Pl => "ourselves"} ;
infVP : Agr -> VP -> Str = \a,vp -> vp.inf ++ vp.adj ! a ++ vp.obj1 ! a ++ vp.obj2 ! a ++ vp.adv ++ vp.ext ;
}