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

PredChi complete

Browse Source
This commit is contained in:
aarne
2014-03-06 07:28:34 +00:00
parent 189318bf25
commit abc6d5c58b
5 changed files with 145 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

131
lib/src/experimental/PredChi.gf
View File

@@ -1,9 +1,134 @@
concrete PredChi of Pred =
CatChi [NP,Utt,IP,IAdv,IComp,Conj,RP,RS,Imp] **
PredFunctor
PredFunctor - [UseNP,ComplV2,SlashV3,ContVPC, StartVPC, StartClC,
RelVP, RelSlash, QuestVP, QuestSlash, QuestIComp,PredVP]
with
(PredInterface = PredInstanceChi) ** open TenseX in {
(PredInterface = PredInstanceChi) ** open ResChi, (P = ParadigmsChi), TenseX in {
lincat Ant = {s : Str ; a : Anteriority} ;
lincat
Ant = {s : Str ; a : Anteriority} ;
lin
UseNP a t p np = useCopula a t p ** {
adj = \\a => np.s
} ;
ComplV2 x vp np = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => appObjCase np, UUnit>
} ;
SlashV3 x vp np = addObj2VP vp (\\a => np.s) ;
RelVP rp vp =
let
rpa = UUnit ;
cl : PrClause = vp ** {
v = applyVerb vp (agr2vagr rpa) ;
subj = rp.s ;
adj = vp.adj ! rpa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! rpa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => rpa ; False => vp.obj1.p2}) ; ---- apply complCase
c3 = noComplCase ; -- for one more prep to build ClSlash
qforms = qformsVP vp (agr2vagr rpa) ;
}
in {s = declCl cl ; c = subjCase} ;
RelSlash rp cl = {
s = rp.s ++ declCl cl ; ---- rp case
c = objCase
} ;
PredVP x np vp =
let npa = UUnit in
vp ** {
v = applyVerb vp (agr2vagr npa) ;
subj = appSubjCase np ;
adj = vp.adj ! npa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! npa ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! npa ;
c3 = vp.c1 ; -- in case there is any free slot left ---- could be c2
qforms = qformsVP vp (agr2vagr npa) ;
} ;
StartVPC x c v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
appPrep v.c1 (v.obj1.p1 ! vpa) ++ appPrep v.c2 (v.obj2.p1 ! vpa) ++ v.adv ++ v.ext
++ (c.s ! CPhr CVPhrase).s2 ++
wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase
appPrep w.c1 (w.obj1.p1 ! vpa) ++ appPrep w.c2 (w.obj2.p1 ! vpa) ++ w.adv ++ w.ext ;
inf = \\a,vt =>
infVP vt a v ++ (c.s ! CPhr CVPhrase).s2 ++ infVP vt a w ;
imp = \\i =>
impVP i v ++ (c.s ! CPhr CVPhrase).s2 ++ impVP i w ;
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = noComplCase ; ---- w.c2 ?
s1 = (c.s ! CPhr CVPhrase).s1 ;
} ;
ContVPC x v w = { ---- some loss of quality seems inevitable
v = \\a =>
let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
appPrep v.c1 (v.obj1.p1 ! vpa) ++ appPrep v.c2 (v.obj2.p1 ! vpa) ++ v.adv ++ v.ext ---- appComplCase
++ "," ++
wv ;
inf = \\a,vt =>
infVP vt a v ++ "," ++ w.inf ! a ! vt ;
imp = \\i =>
impVP i v ++ "," ++ w.imp ! i ;
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
c2 = noComplCase ; ---- w.c2 ?
s1 = w.s1 ;
} ;
StartClC x c a b = {
s = declCl a ++ (c.s ! CSent).s2 ++ declCl b ;
c3 = b.c3 ; ----
s1 = (c.s ! CSent).s1 ;
} ;
QuestVP x ip vp =
let
ipa = ipagr2agr UUnit
in {
v = applyVerb vp UUnit ;
foc = ip.s ;
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ipa ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ipa ; False => vp.obj1.p2}) ; ---- appComplCase
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
adv = vp.adv ;
adV = vp.adV ;
ext = vp.ext ;
qforms = qformsVP vp (ipagr2vagr UUnit) ;
} ;
QuestSlash x ip cl =
let
prep = cl.c3 ;
ips = ip.s ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
focobj = case cl.focType of {
NoFoc => <ips, [], FocObj,prep> ; -- put ip object to focus if there is no focus yet
t => <[], strComplCase prep ++ ips, t,noComplCase> -- put ip object in situ if there already is a focus
} ;
in
cl ** { -- preposition stranding
foc = focobj.p1 ;
focType = focobj.p3 ;
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
c3 = focobj.p4 ;
} ;
}

12
lib/src/experimental/PredFunctor.gf
View File

@@ -120,7 +120,7 @@ lin
} ;
UseNP a t p np = useCopula a t p ** {
adj = \\a => np.s ! subjCase ;
adj = \\a => appSubjCase np ;
} ;
UseS a t p cl = addExtVP (useCopula a t p) (that_Compl ++ declSubordCl cl) ; ---- sentence form
@@ -128,7 +128,7 @@ lin
UseVP a t p vp = addExtVP (useCopula a t p) (vp.s ! vvInfinitive ! defaultAgr) ;
ComplV2 x vp np = vp ** {
obj1 = <\\a => np.s ! objCase, np.a> -- np.a for object control
obj1 = <\\a => appObjCase np, np.a> -- np.a for object control
} ;
ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl cl) ; ---- sentence form
@@ -141,7 +141,7 @@ lin
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm
SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved
SlashV3 x vp np = addObj2VP vp (\\a => appObjCase np) ; -- control is preserved
SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl cl) ; ---- sentence form
@@ -165,7 +165,7 @@ lin
PredVP x np vp = vp ** {
v = applyVerb vp (agr2vagr np.a) ;
subj = np.s ! subjCase ;
subj = appSubjCase np ;
adj = vp.adj ! np.a ;
obj1 = vp.part ++ strComplCase vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj
obj2 = strComplCase vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase
@@ -187,7 +187,7 @@ lin
ipa = ipagr2agr ip.n
in {
v = applyVerb vp (ipagr2vagr ip.n) ;
foc = ip.s ! subjCase ; -- who (loves her)
foc = ip.s ! subjCase ;
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ipa ;
@@ -230,7 +230,7 @@ lin
let vagr = (agr2vagr np.a) in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = np.s ! subjCase ;
subj = appSubjCase np ;
adV = negAdV p ;
foc = icomp.s ! agr2icagr np.a ;
focType = FocObj ;

8
lib/src/experimental/PredInstanceChi.gf
View File

@@ -1,5 +1,5 @@
instance PredInstanceChi of
PredInterface - [PrVerb,initPrVerb] =
PredInterface - [PrVerb,initPrVerb,NounPhrase,appSubjCase,appObjCase] =
open ResChi, (P = ParadigmsChi), (X = ParamX), (S = SyntaxChi), Prelude in {
@@ -19,6 +19,10 @@ oper
} ;
NounPhrase = {s : Str} ;
appSubjCase : NounPhrase -> Str = \np -> np.s ;
appObjCase : NounPhrase -> Str = \np -> np.s ;
---------------------
-- parameters -------
@@ -52,7 +56,7 @@ oper
ComplCase = Preposition ;
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appPrep p (np.s ! UUnit) ; ---- advType
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> appPrep p np.s ; ---- advType
noComplCase : ComplCase = P.mkPrep [] ;
strComplCase : ComplCase -> Str = \c -> c.prepPre ++ c.prepPost ;

3
lib/src/experimental/PredInterface.gf
View File

@@ -57,6 +57,9 @@ oper
appComplCase : ComplCase -> NounPhrase -> Str ;
noComplCase : ComplCase ;
appSubjCase : NounPhrase -> Str = \np -> np.s ! subjCase ;
appObjCase : NounPhrase -> Str = \np -> np.s ! objCase ;
noObj : Agr => Str = \\_ => [] ;
RPCase : PType ;

2
lib/src/experimental/transfer/Old2New.hs
View File

@@ -145,6 +145,8 @@ onVPSlash t a p vps = case vps of
GSlashV2V v2v ant pol vp -> GSlashV2V_none (GUseV_np_v a t p (GLiftV2V v2v)) (GInfVP_none (onVP GTPres ant pol vp)) -- !!
GSlashVV vv vps -> GComplVV_np (GUseV_v a t p (GLiftVV vv)) (GInfVP_np (onVPSlash GTPres GASimul GPPos vps)) -- !!
--- GSlashSlashV2V vv ant pol vps -> GComplVV_np (GUseV_np_v a t p (GLiftV2V vv)) (GInfVP_np (onVPSlash GTPres ant pol vps))
GSlashVPIV2V v2v pol vpi -> GSlashV2V_none (GUseV_np_v a t p (GLiftV2V v2v)) (GInfVP_none (onVPI2VP vpi))
onVPSlashPass :: GTense -> GAnt -> GPol -> Tree GVPSlash_ -> Tree GPrVP_none_
onVPSlashPass t a p vps = case vps of