forked from GitHub/gf-rgl
266 lines
8.2 KiB
Plaintext
266 lines
8.2 KiB
Plaintext
--# -path=.:../common:../abstract
|
|
|
|
concrete ExtendFin of Extend =
|
|
CatFin ** ExtendFunctor - [
|
|
VPI2,VPS2,MkVPS,MkVPS2,ConjVPS2,ComplVPS2, ConsVPS, BaseVPS, ListVPS, VPS, ConjVPS,PredVPS,
|
|
MkVPI2,ConjVPI2,ComplVPI2,ComplVPIVV
|
|
,ExistCN, ExistMassCN, ICompAP, ByVP
|
|
,CompoundN, GenNP, GenIP, AdvIsNP, EmbedSSlash
|
|
,PassVPSlash, PassAgentVPSlash
|
|
,CardCNCard
|
|
,UttAccNP
|
|
,AdjAsCN, AdjAsNP
|
|
,ApposNP
|
|
,PresPartAP, PastPartAP
|
|
]
|
|
with
|
|
(Grammar = GrammarFin) **
|
|
|
|
open
|
|
GrammarFin,
|
|
ResFin,
|
|
StemFin,
|
|
(S=StemFin),
|
|
(P=PhraseFin),
|
|
IdiomFin,
|
|
Coordination,
|
|
Prelude,
|
|
MorphoFin,
|
|
ParadigmsFin in {
|
|
|
|
lin
|
|
ExistCN cn =
|
|
let
|
|
pos = ExistNP (DetCN (DetQuant IndefArt NumSg) cn) ;
|
|
neg = ExistNP (partCN cn) ;
|
|
in posNegClause pos neg ;
|
|
ExistMassCN cn = ExistNP (partCN cn) ;
|
|
|
|
oper
|
|
partCN : CN -> GrammarFin.NP ;
|
|
partCN cn =
|
|
let
|
|
acn = DetCN (DetQuant IndefArt NumSg) cn
|
|
in acn ** {
|
|
s = table {
|
|
NPCase Nom | NPAcc => acn.s ! NPCase ResFin.Part ;
|
|
c => acn.s ! c
|
|
}
|
|
} ;
|
|
|
|
|
|
lincat
|
|
VPS = {
|
|
s : Agr => Str ;
|
|
sc : SubjCase ; --- can be different for diff parts
|
|
h : Harmony --- can be different for diff parts
|
|
} ;
|
|
|
|
[VPS] = {
|
|
s1,s2 : Agr => Str ;
|
|
sc : SubjCase ; --- take the first: minä osaan kutoa ja täytyy virkata
|
|
h : Harmony --- take the first: osaanko minä kutoa ja käyn koulua
|
|
} ;
|
|
|
|
VPI = {s : VVType => Agr => Str ; sc : SubjCase } ; -- Agr needed for possessive suffix:
|
|
[VPI] = {s1,s2 : VVType => Agr => Str ; sc : SubjCase } ; -- e.g. toivon nukkuva+ni
|
|
|
|
lin
|
|
MkVPS t p vp0 = let vp = vp2old_vp vp0 in
|
|
{ -- Temp -> Pol -> VP -> VPS ;
|
|
s = \\a =>
|
|
let
|
|
agrfin = case vp.sc of {
|
|
SCNom => <a,True> ;
|
|
_ => <agrP3 Sg,False> -- minun täytyy, minulla on
|
|
} ;
|
|
vps = vp.s ! VIFin t.t ! t.a ! p.p ! agrfin.p1
|
|
in
|
|
t.s ++ p.s ++
|
|
vps.fin ++ vps.inf ++
|
|
vp.s2 ! agrfin.p2 ! p.p ! a ++
|
|
vp.adv ! p.p ++
|
|
vp.ext ;
|
|
sc = vp.sc ;
|
|
h = vp.h
|
|
} ;
|
|
|
|
BaseVPS x y = twoTable Agr x y ** {sc = x.sc ; h = x.h} ;
|
|
ConsVPS x y = consrTable Agr comma x y ** {sc = x.sc ; h = x.h} ;
|
|
|
|
ConjVPS conj ss = conjunctDistrTable Agr conj ss ** {
|
|
sc = ss.sc ; h = ss.h
|
|
} ;
|
|
|
|
PredVPS np vps = { -- NP -> VPS -> S ;
|
|
s = subjForm np vps.sc Pos ++ vps.s ! np.a
|
|
} ;
|
|
|
|
|
|
BaseVPI = twoTable2 VVType Agr ;
|
|
ConsVPI = consrTable2 VVType Agr comma ;
|
|
|
|
|
|
|
|
MkVPI vp = mkVPI vp ;
|
|
ConjVPI c xs = conjunctDistrTable2 VVType Agr c xs ;
|
|
ComplVPIVV vv vpi =
|
|
S.insertObj (\\_,_,a => vpi.s ! vv.vi ! a)
|
|
(S.predV (vv ** {sc = case vpi.sc of {
|
|
SCNom => vv.sc ; -- minun täytyy pestä auto
|
|
c => c }}) -- minulla täytyy olla auto
|
|
) ;
|
|
|
|
|
|
-------- two-place verb conjunction
|
|
|
|
lincat
|
|
-- Polarity needed to pick the right object case
|
|
VPS2 = {s : Agr => Str ; c2 : Compl ; p : Polarity ; sc : SubjCase ; h : Harmony} ;
|
|
[VPS2] = {s1,s2 : Agr => Str ; c2 : Compl ; p : Polarity ; sc : SubjCase ; h : Harmony} ;
|
|
-- A version with
|
|
VPI2 = {s : VVType => Agr => Str ; c2 : Compl ; sc : SubjCase } ;
|
|
[VPI2] = {s1,s2 : VVType => Agr => Str ; c2 : Compl ; sc : SubjCase } ;
|
|
|
|
lin
|
|
-- : Temp -> Pol -> VPSlash -> VPS2 ; -- has loved
|
|
MkVPS2 t p vpsl = mkVPS t p (lin VP vpsl) ** {c2 = vpsl.c2 ; p = p.p} ;
|
|
|
|
-- : VPSlash -> VPI2 ; -- to love
|
|
MkVPI2 vpsl = mkVPI (lin VP vpsl) ** {c2 = vpsl.c2} ;
|
|
|
|
BaseVPS2 x y = twoTable Agr x y ** {c2 = y.c2 ; p = xs.p } ; ---- just remembering the compl. case of the latter verb
|
|
ConsVPS2 x xs = consrTable Agr comma x xs ** {c2 = xs.c2 ; p = xs.p } ;
|
|
|
|
BaseVPI2 x y = twoTable2 VVType Agr x y ** {c2 = y.c2} ; ---- just remembering the compl. case of the latter verb
|
|
ConsVPI2 x xs = consrTable2 VVType Agr comma x xs ** {c2 = xs.c2} ;
|
|
|
|
|
|
ConjVPS2 c xs = conjunctDistrTable Agr c xs ** {c2 = xs.c2 ; p = xs.p ; sc = xs.sc ; h = xs.h} ;
|
|
ConjVPI2 c xs = conjunctDistrTable2 VVType Agr c xs ** {c2 = xs.c2 ; p = xs.p ; sc = xs.sc } ;
|
|
|
|
|
|
-- appCompl : Bool -> Polarity -> Compl -> ResFin.NP -> Str
|
|
ComplVPS2 v np = v ** { s = \\agr => v.s ! agr ++ appCompl True v.p v.c2 np } ;
|
|
|
|
-- TODO: Version with variable polarity?
|
|
ComplVPI2 v np = v ** { s = \\vt,a => v.s ! vt ! a ++ appCompl True Pos v.c2 np };
|
|
|
|
oper
|
|
mkVPS : Temp -> Pol -> VP -> VPS = \tem,pol,vp -> lin VPS {
|
|
s = \\agr => (UseCl tem pol (S.mkClause (\_ -> []) agr vp)).s ;
|
|
h = vp.s.h ; sc = vp.s.sc
|
|
} ;
|
|
|
|
mkVPI : VP -> VPI = \vp -> lin VPI {
|
|
s = \\vt,agr => S.infVP vp.s.sc Pos agr vp (vvtype2infform vt) ;
|
|
sc = vp.s.sc } ;
|
|
|
|
lin
|
|
CompoundN n1 n2 =
|
|
let ukkos_ = (S.snoun2nounBind n1).s ! NCompound in {
|
|
s = \\c => ukkos_ ++ BIND ++ n2.s ! c ;
|
|
h = n2.h
|
|
} ;
|
|
|
|
---- copied from VerbFin.CompAP, should be shared
|
|
ICompAP ap = {
|
|
s = \\agr =>
|
|
let
|
|
n = complNumAgr agr ;
|
|
c = case n of {
|
|
Sg => Nom ; -- minä olen iso ; te olette iso
|
|
Pl => ResFin.Part -- me olemme isoja ; te olette isoja
|
|
} --- definiteness of NP ?
|
|
in "kuinka" ++ ap.s ! False ! (NCase n c)
|
|
} ;
|
|
|
|
lin
|
|
GenNP np = {
|
|
s1,sp = \\_,_ => np.s ! NPCase Gen ;
|
|
s2 = case np.isPron of { -- "isän auto", "hänen autonsa"
|
|
True => table {Front => BIND ++ possSuffixFront np.a ;
|
|
Back => BIND ++ possSuffix np.a } ;
|
|
False => \\_ => []
|
|
} ;
|
|
isNum = False ;
|
|
isPoss = np.isPron ; --- also gives "sen autonsa"
|
|
isDef = True ; --- "Jussin kolme autoa ovat" ; thus "...on" is missing
|
|
isNeg = False
|
|
} ;
|
|
|
|
GenIP ip = {s = \\_,_ => ip.s ! NPCase Gen} ;
|
|
|
|
ByVP vp = lin Adv {s = S.infVP vp.s.sc Pos (Ag Sg P3) vp Inf3Adess} ; ---- Agr ?
|
|
|
|
AdvIsNP adv np = S.mkClause (\_ -> adv.s) np.a (UseComp (CompNP np)) ;
|
|
|
|
-- : SSlash -> SC
|
|
EmbedSSlash ss =
|
|
let it_NP : NP = UsePron it_Pron ;
|
|
thatWhich : NP = it_NP ** {
|
|
s = \\nc => it_NP.s ! NPSep ++ case nc of {
|
|
NPCase c => mikaInt ! Sg ! c ;
|
|
NPAcc => mikaInt ! Sg ! Gen ;
|
|
NPSep => mikaInt ! Sg ! Nom }
|
|
} ;
|
|
in {s = appCompl True Pos ss.c2 thatWhich ++ ss.s} ;
|
|
|
|
PassVPSlash vp = S.passVP vp vp.c2 ;
|
|
|
|
PassAgentVPSlash vp np = {
|
|
s = {s = vp.s.s ; h = vp.s.h ; p = vp.s.p ; sc = npform2subjcase vp.c2.c} ;
|
|
s2 = \\b,p,a => np.s ! NPSep ++ vp.s2 ! b ! p ! a ;
|
|
adv = vp.adv ;
|
|
ext = vp.ext ;
|
|
vptyp = vp.vptyp ;
|
|
} ;
|
|
|
|
UseDAP, UseDAPFem, UseDAPMasc = \dap ->
|
|
let
|
|
n : ParadigmsFin.Number = case dap.isNum of {
|
|
True => Sg ;
|
|
_ => dap.n
|
|
} ;
|
|
in {
|
|
s = \\c => let k = npform2case n c in
|
|
dap.sp ! k ; -- det.s2 is possessive suffix
|
|
a = agrP3 (case dap.isDef of {
|
|
False => Sg ; -- autoja menee; kolme autoa menee
|
|
_ => dap.n
|
|
}) ;
|
|
isPron = False ; isNeg = dap.isNeg
|
|
} ;
|
|
|
|
lin CardCNCard card cn = {
|
|
s = \\n,c =>
|
|
let k = case <card.n, c> of {<Pl,Nom> => Part ; _ => c}
|
|
in card.s ! n ! c ++ cn.s ! NCase Sg k ;
|
|
n = Pl
|
|
} ;
|
|
|
|
lin UttAccNP np = {s = P.addNegation np.isNeg ++ np.s ! NPAcc} ;
|
|
lin AdjAsCN ap = {s = ap.s ! True ; postmod = \\_ => ap.p ; h = Back} ; ---- Harmony just a guess
|
|
lin AdjAsNP ap = MassNP (AdjAsCN ap) ;
|
|
lin ApposNP np1 np2 = np1 ** {s = \\npf => np1.s ! npf ++ np2.s ! NPSep} ;
|
|
lin PresPartAP vp = {
|
|
s = \\_,nf => preCompVP vp (PresPartAct (AN nf)) ;
|
|
p = [] ;
|
|
hasPrefix = False
|
|
} ;
|
|
lin PastPartAP vps = {
|
|
s = \\_,nf => preCompVP <vps : VP> (PastPartAct (AN nf)) ;
|
|
p = vps.c2.s.p1 ;
|
|
hasPrefix = False
|
|
} ;
|
|
|
|
oper
|
|
-- ruohoa syövä, Ranskassa valmistettu
|
|
preCompVP : S.VP -> VForm -> Str = \vp, vform ->
|
|
vp.s2 ! True ! Pos ! agrP3 Sg ++
|
|
vp.adv ! Pos ++
|
|
vp.s.s ! vform ++
|
|
vp.ext ;
|
|
|
|
}
|