gf-3.6: lib/src/experimental/PredChi.gf
concrete PredChi of Pred =
CatChi [NP,Utt,IP,IAdv,IComp,Conj,RP,RS,Imp,Subj] **
PredFunctor - [UseNP,ComplV2,SlashV3,ContVPC, StartVPC, StartClC,
RelVP, RelSlash, QuestVP, QuestSlash, QuestIComp,PredVP,
SubjUttPreS, SubjUttPreQ, SubjUttPost,
UseAdv, ComplAdv, UseAdvCl, AdvQCl, AdvCl
]
with
(PredInterface = PredInstanceChi) ** open ResChi, (P = ParadigmsChi), TenseX in {
lincat
Ant = {s : Str ; a : PredInstanceChi.Anteriority} ;
lin
UseNP a t p np = useCopula a t p ** {
adj = \\a => np.s
} ;
UseAdv x a t p adv =
let verb = case adv.advType of {
ATPlace True => liftV noVerb ;
_ => liftV zai_V
}
in initPrVerbPhraseV a t p verb ** {
adv = adv.prepPre ++ adv.prepPost ;
} ;
ComplAdv x p np = {prepPre = appComplCase p np ; prepPost = [] ; advType = p.advType} ;
UseAdvCl adv cl = {s = adv.prepPre ++ adv.prepPost ++ declInvCl cl} ;
AdvCl, AdvQCl = \x,adv,cl ->
let advs = adv.prepPre ++ adv.prepPost in
case adv.advType of {
ATManner => cl ** {obj1 = deVAdv_s ++ advs ++ cl.obj1} ; -- he sleeps *well*
ATPlace True => cl ** {adv = cl.adv ++ advs} ; -- he today *in the house* sleeps
ATPlace False => cl ** {adv = cl.adv ++ zai_V.s ++ advs} ; -- he today *here* sleeps
ATTime | _ => cl ** {adv = advs ++ cl.adv} -- he *today* here sleeps ---- also: **today** he here sleeps
} ;
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
}
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
} ;
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 ;
} ;
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 ;
} ;
QuestIComp a t p icomp np =
let vagr = UUnit in
initPrClause ** {
v = tenseCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
subj = appSubjCase np ;
adV = negAdV p ;
foc = icomp.s ;
focType = FocObj ;
} ;
NomVPNP vp = ss (vp.s ! UUnit ! UUnit) ;----
SubjUttPreS subj cl s = ss (subj.prePart ++ declSubordCl cl ++ subj.sufPart ++ declInvCl s) ;
SubjUttPreQ subj cl q = ss (subj.prePart ++ declSubordCl cl ++ subj.sufPart ++ questCl q) ;
SubjUttPost subj cl utt = ss (utt.s ++ subj.prePart ++ declSubordCl cl ++ subj.sufPart) ;
---- todo
AfterVP,
BeforeVP,
ByVP,
InOrderVP,
WhenVP,
WithoutVP
= variants {} ;
}