forked from GitHub/gf-core
244 lines
6.8 KiB
Plaintext
244 lines
6.8 KiB
Plaintext
--# -path=.:../finnish/stemmed:../finnish:../common:alltenses
|
|
|
|
concrete PredFin of Pred =
|
|
CatFin [Ant,NP,Utt,IP,IAdv,IComp,Conj,Subj,RP,RS] **
|
|
PredFunctor
|
|
- [
|
|
|
|
-- overridden
|
|
UseV
|
|
,UseAP
|
|
,UseNP
|
|
,UseCN
|
|
,QuestVP
|
|
,PredVP
|
|
,ComplV2
|
|
,ReflVP2
|
|
,ReflVP
|
|
,RelVP
|
|
,RelSlash
|
|
,QuestIComp
|
|
,PassUseV
|
|
,PresPartAP
|
|
,PastPartAP
|
|
,AgentPastPartAP
|
|
,AgentPassUseV
|
|
,UseVPC
|
|
,StartVPC
|
|
,ContVPC
|
|
,ComplVV
|
|
,SlashV2V
|
|
]
|
|
|
|
with
|
|
(PredInterface = PredInstanceFin) ** open PredInstanceFin, (S = StemFin), ResFin in {
|
|
|
|
lin
|
|
ComplVV x vp vpo = addObj2VP vp (\\a => vpo.s ! VPIVV vp.vvtype ! a) ;
|
|
SlashV2V x vp vpo = addObj2VP vp (\\a => vpo.s ! VPIVV vp.vvtype ! a) ;
|
|
|
|
UseV x a t p verb = initPrVerbPhraseV a t p verb ;
|
|
|
|
UseAP x a t p ap = useCopula a t p ** {
|
|
c1 = ap.c1 ;
|
|
c2 = ap.c2 ;
|
|
adj = \\a => ap.s ! agr2aagr a ;
|
|
} ;
|
|
|
|
UseNP a t p np = useCopula a t p ** {
|
|
adj = \\a => np.s ! subjCase ;
|
|
} ;
|
|
|
|
UseCN x a t p cn = useCopula a t p ** {
|
|
c1 = cn.c1 ;
|
|
c2 = cn.c2 ;
|
|
adj = \\a => cn.s ! agr2nagr a ;
|
|
} ;
|
|
|
|
ComplV2 x vp np = vp ** {
|
|
obj1 = \\_ => appCompl True Pos vp.c1 np ; ---- True,Pos ?
|
|
} ;
|
|
|
|
PredVP x np vp = vp ** {
|
|
subj : Str = appSubjCase vp.sc np ;
|
|
verb : {fin,inf : Str} = vp.v ! np.a ;
|
|
adj : Str = vp.adj ! np.a ;
|
|
obj1 : Str = vp.obj1 ! np.a ;
|
|
obj2 : Str = vp.obj2 ! np.a ;
|
|
c3 : Compl = vp.c1 ; ---- could be c2
|
|
} ;
|
|
|
|
ReflVP x vp = vp ** {
|
|
obj1 = \\a => (reflPron a).s ! vp.c1.c ; ---- prep
|
|
} ;
|
|
|
|
ReflVP2 x vp = vp ** {
|
|
obj2 = \\a => (reflPron a).s ! vp.c2.c ; ---- prep
|
|
} ;
|
|
|
|
QuestVP x ip vp =
|
|
let
|
|
ipa = ipagr2agr ip.n
|
|
in vp ** {
|
|
foc = ip.s ! subjCase ; ---- appSubjCase ip
|
|
focType = FocSubj ;
|
|
subj = [] ;
|
|
verb : {fin,inf : Str} = vp.v ! ipa ;
|
|
adj : Str = vp.adj ! ipa ;
|
|
obj1 : Str = vp.obj1 ! ipa ;
|
|
obj2 : Str = vp.obj2 ! ipa ;
|
|
c3 : Compl = noComplCase ;
|
|
qforms = \\_ => <[],[]> ;
|
|
} ;
|
|
|
|
QuestIComp a t p icomp np =
|
|
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 ;
|
|
foc = icomp.s ! np.a ;
|
|
focType = FocObj ;
|
|
qforms = qformsCopula (a.s ++ t.s ++ p.s) t.t a.a p.p vagr ;
|
|
} ;
|
|
|
|
RelVP rp vp =
|
|
let
|
|
cl : Agr -> PrClause = \a ->
|
|
let
|
|
rpa = rpagr2agr rp.a a ;
|
|
rnp = {s = rp.s ! (complNumAgr rpa) ; a = rpa ; isPron = False}
|
|
in
|
|
vp ** {
|
|
v = applyVerb vp (agr2vagr rpa) ;
|
|
subj : Str = appSubjCase vp.sc rnp ;
|
|
verb : {fin,inf : Str} = vp.v ! rpa ;
|
|
adj : Str = vp.adj ! rpa ;
|
|
obj1 : Str = vp.obj1 ! rpa ;
|
|
obj2 : Str = vp.obj2 ! rpa ;
|
|
c3 : Compl = noComplCase ;
|
|
}
|
|
in {s = \\a => declCl (cl a) ; c = subjCase} ; ---- case
|
|
|
|
RelSlash rp cl = {
|
|
s = \\a =>
|
|
let
|
|
rpa = rpagr2agr rp.a a ;
|
|
rnp = appCompl True Pos cl.c3 {s = rp.s ! (complNumAgr rpa) ; a = rpa ; isPron = False}
|
|
in
|
|
rnp ++ declCl cl ;
|
|
c = objCase ---- case
|
|
} ;
|
|
|
|
NomVPNP vpi = {
|
|
s = \\c => vpi.s ! vvInfinitive ! defaultAgr ;
|
|
isNeg = False ; ----
|
|
isPron = False ; ----
|
|
a = defaultAgr
|
|
} ;
|
|
|
|
|
|
PassUseV x a t p verb = initPrVerbPhraseV a t p verb ** {
|
|
v : Agr => {fin,inf : Str} = case verb.sc of {
|
|
SCNom => \\agr => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr (lin PrV verb) ;
|
|
_ => \\_ => finV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass defaultAgr (lin PrV verb)
|
|
} ;
|
|
inf : VPIType => Str = \\vtt => tenseInfV (a.s ++ p.s) a.a p.p Pass (lin PrV verb) vtt ; ---- still Act
|
|
imp : ImpType => Str = \\it => imperativeV p.s p.p it (lin PrV verb) ; ---- still Act
|
|
isPass : Bool = True ;
|
|
c1 : Compl = noComplCase ;
|
|
c2 : Compl = verb.c2 ;
|
|
vvtype = verb.vvtype ;
|
|
sc = npform2subjcase verb.c1.c ;
|
|
h = case a.a of {Anter => Back ; _ => verb.h} ;
|
|
} ;
|
|
|
|
AgentPassUseV x a t p verb np = initPrVerbPhraseV a t p verb ** {
|
|
sc = npform2subjcase verb.c1.c ;
|
|
obj1 = \\a => appSubjCase verb.sc np ;
|
|
} ;
|
|
|
|
PresPartAP x v = {
|
|
s = \\a => vPresPart v a ;
|
|
c1 = v.c1 ; -- looking at her
|
|
c2 = v.c2 ;
|
|
obj1 = noObj ;
|
|
} ;
|
|
|
|
PastPartAP x v = {
|
|
s = \\a => vPastPart v a ;
|
|
c1 = v.c1 ; -- looking at her
|
|
c2 = v.c2 ;
|
|
obj1 = noObj ;
|
|
} ;
|
|
|
|
AgentPastPartAP x v np = {
|
|
s = \\a => (S.sverb2verbSep v).s ! AgentPart (aForm a) ;
|
|
c1 = v.c1 ;
|
|
c2 = v.c2 ;
|
|
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
|
|
} ;
|
|
|
|
|
|
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.fin ++ v.adV ++ vv.inf ++ v.adj ! vpa ++
|
|
v.obj1 ! vpa ++ v.obj2 ! vpa ++ v.adv ++ v.ext
|
|
++ c.s2 ++
|
|
wv.fin ++ w.adV ++ wv.inf ++ w.adj ! vpa ++
|
|
w.obj1 ! vpa ++ w.obj2 ! vpa ++ w.adv ++ w.ext ;
|
|
inf = \\a,vt =>
|
|
infVP vt a v ++ c.s2 ++ infVP vt a w ;
|
|
imp = \\i =>
|
|
impVP i v ++ c.s2 ++ impVP i w ;
|
|
c1 = noComplCase ; ---- w.c1 ? --- the full story is to unify v and w...
|
|
c2 = noComplCase ; ---- w.c2 ?
|
|
s1 = c.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.fin ++ v.adV ++ vv.inf ++ v.adj ! vpa ++
|
|
v.obj1 ! vpa ++ v.obj2 ! vpa ++ v.adv ++ v.ext
|
|
++ "," ++
|
|
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 ;
|
|
} ;
|
|
|
|
UseVPC x vpc = initPrVerbPhrase ** { ---- big loss of quality (overgeneration) seems inevitable
|
|
v = \\a => {fin = vpc.s1 ++ vpc.v ! a ; inf = []} ;
|
|
inf = \\vt => vpc.inf ! defaultAgr ! vt ; ---- agr
|
|
imp = vpc.imp ;
|
|
c1 = vpc.c1 ;
|
|
c2 = vpc.c2 ;
|
|
} ;
|
|
|
|
|
|
ByVP x vp vpi = vp ** {adv = vpi.s ! VPIInf3Adess ! defaultAgr} ; -- tekemällä
|
|
WhenVP x vp vpi = vp ** {adv = vpi.s ! VPIInf2Iness ! defaultAgr} ; -- tehdessä ---- agr
|
|
BeforeVP x vp vpi = vp ** {adv = "ennen" ++ vpi.s ! VPIInf4Part ! defaultAgr} ; -- ennen tekemistä
|
|
InOrderVP x vp vpi = vp ** {adv = vpi.s ! VPIInf1Long ! defaultAgr} ; -- tehdäkseen ---- agr
|
|
WithoutVP x vp vpi = vp ** {adv = vpi.s ! VPIInf3Abess ! defaultAgr} ; -- tekemättä
|
|
|
|
AfterVP -- tehtyä
|
|
= variants {} ;
|
|
|
|
}
|