mirror of
https://github.com/GrammaticalFramework/gf-rgl.git
synced 2026-06-12 00:20:11 -06:00
440 lines
14 KiB
Plaintext
440 lines
14 KiB
Plaintext
--# -path=.:../common:../abstract
|
|
|
|
concrete ExtendEst of Extend =
|
|
CatEst ** ExtendFunctor -
|
|
[
|
|
-- Extensions of VP
|
|
VPS, ListVPS, VPI, ListVPI, VPS2, ListVPS2, VPI2, ListVPI2,
|
|
MkVPS, BaseVPS, ConsVPS, ConjVPS, PredVPS, QuestVPS, SQuestVPS, RelVPS,
|
|
MkVPI, BaseVPI, ConsVPI, ConjVPI, ComplVPIVV,
|
|
MkVPS2, BaseVPS2, ConsVPS2, ConjVPS2, ComplVPS2, ReflVPS2,
|
|
MkVPI2, BaseVPI2, ConsVPI2, ConjVPI2, ComplVPI2,
|
|
|
|
-- Reflexives
|
|
RNP, RNPList, Base_nr_RNP, Base_rn_RNP, Base_rr_RNP, ConjRNP, Cons_nr_RNP, Cons_rr_RNP, PredetRNP, ReflRNP, ReflPoss, ReflPron,
|
|
|
|
-- Rest in alphabetical order
|
|
AdAdV, AdjAsCN, AdjAsNP, ApposNP, AdvIsNP, A2VPSlash, ByVP,
|
|
CardCNCard, CompBareCN, CompIQuant, CompQS, CompS, CompVP,
|
|
ComplBareVS, ComplGenVV, ComplSlashPartLast, ComplVPSVV, CompoundAP, CompoundN,
|
|
EmbedPresPart, EmbedSSlash, EmptyRelSlash, ExistsNP, ExistCN, ExistMassCN, ExistPluralCN,
|
|
FocusAP, FocusAdV, FocusAdv, FocusObj, FrontComplDirectVQ, FrontComplDirectVS,
|
|
GenIP, GenModIP, GenModNP, GenNP, GenRP, GerundAdv, GerundCN, GerundNP,
|
|
IAdvAdv, ICompAP, InOrderToVP, N2VPSlash, NominalizeVPSlashNP,
|
|
PassAgentVPSlash, PassVPSlash, PastPartAP, PastPartAgentAP, PositAdVAdj,
|
|
PredAPVP, PredIAdvVP, PredVPSVV, PresPartAP, PrepCN, ProDrop, ProgrVPSlash, PurposeVP,
|
|
SlashBareV2S, UttAccIP, UttAccNP, UttAdV, UttDatIP, UttDatNP, UttVPShort, WithoutVP
|
|
|
|
|
|
]
|
|
with
|
|
(Grammar = GrammarEst) **
|
|
|
|
open
|
|
GrammarEst,
|
|
ResEst,
|
|
(R=ResEst),
|
|
(X=ExtraEst),
|
|
IdiomEst,
|
|
Coordination,
|
|
Prelude,
|
|
MorphoEst,
|
|
LexiconEst,
|
|
ParadigmsEst in {
|
|
|
|
---------------------------------
|
|
-- VPS, VPI, VPS2 + list versions
|
|
lincat
|
|
VPS = X.VPS ;
|
|
[VPS] = X.ListVPS ;
|
|
VPI = X.VPI ;
|
|
[VPI] = X.ListVPI ;
|
|
VPS2 = X.VPS ** {c2 : Compl} ;
|
|
[VPS2] = X.ListVPS ** {c2 : Compl} ;
|
|
VPI2 = X.VPI ** {c2 : Compl} ;
|
|
[VPI2] = X.ListVPI ** {c2 : Compl} ;
|
|
|
|
linref
|
|
VPS = X.linVPS (agrP3 Sg) ;
|
|
VPI = X.linVPI InfMa ;
|
|
|
|
lin
|
|
MkVPS = X.MkVPS ;
|
|
BaseVPS = X.BaseVPS ;
|
|
ConsVPS = X.ConsVPS ;
|
|
ConjVPS = X.ConjVPS ;
|
|
|
|
PredVPS = X.PredVPS ;
|
|
-- QuestVPS
|
|
-- SQuestVPS
|
|
-- RelVPS
|
|
|
|
MkVPI = X.MkVPI ;
|
|
BaseVPI = X.BaseVPI ;
|
|
ConsVPI = X.ConsVPI ;
|
|
ConjVPI = X.ConjVPI ;
|
|
ComplVPIVV = X.ComplVPIVV ;
|
|
|
|
MkVPS2 t p vps = MkVPS t p vps ** {c2 = vps.c2} ;
|
|
-- BaseVPS2, ConsVPS2, ConjVPS2,
|
|
|
|
ComplVPS2 v np = lin VPS (v ** {
|
|
-- TODO: param to record whether it's pos or neg, so we get right form of np
|
|
s = \\agr => v.s ! agr ++ appCompl True Pos v.c2 np ;
|
|
}) ;
|
|
|
|
-- ReflVPS2 v rnp =
|
|
-- MkVPI2, BaseVPI2, ConsVPI2, ConjVPI2, ComplVPI2,
|
|
|
|
---------------------------------
|
|
-- RNP + all related funs
|
|
|
|
lincat
|
|
RNP = {s : Agr => NPForm => Str} ;
|
|
RNPList = {s1,s2 : Agr => NPForm => Str} ;
|
|
|
|
oper
|
|
rnp2np : Agr -> RNP -> NPhrase = \agr,rnp -> emptyNP ** {
|
|
a = agr ;
|
|
s = rnp.s ! agr ;
|
|
isPron = False ; -- ??
|
|
} ;
|
|
|
|
lin
|
|
-- : VPSlash -> RNP -> VP ; -- support my family and myself
|
|
ReflRNP vps rnp = insertObj (\\b,p,a => appCompl True Pos vps.c2 (rnp2np a rnp)) vps ;
|
|
|
|
-- : RNP
|
|
ReflPron = {s = \\agr,npf => (reflPron agr).s ! npf} ;
|
|
|
|
-- : Num -> CN -> RNP ; -- my car(s)
|
|
ReflPoss num cn = {
|
|
s = \\a,npf => possPron ! a ++ num.s ! Sg ! Nom ++
|
|
case npf of {
|
|
NPCase c => cn.s ! NCase num.n c ;
|
|
NPAcc => cn.s ! NCase num.n Gen } ;
|
|
} ;
|
|
|
|
PredetRNP predet rnp = {
|
|
s = \\a,c => case a of {
|
|
Ag n p => predet.s ! n ! c ++ rnp.s ! a ! c ;
|
|
AgPol => predet.s ! Pl ! c ++ rnp.s ! a ! c }
|
|
} ;
|
|
|
|
ConjRNP conj rpns = conjunctDistrTable2 Agr NPForm conj rpns ;
|
|
|
|
Base_rr_RNP x y = twoTable2 Agr NPForm x y ;
|
|
Base_nr_RNP x y = twoTable2 Agr NPForm {s = \\a => x.s} y ;
|
|
Base_rn_RNP x y = twoTable2 Agr NPForm x {s = \\a => y.s} ;
|
|
Cons_rr_RNP x xs = consrTable2 Agr NPForm comma x xs ;
|
|
Cons_nr_RNP x xs = consrTable2 Agr NPForm comma {s = \\a => x.s} xs ;
|
|
|
|
{-
|
|
-- : Pron -> Num -> CN -> RNP -> NP ; -- his abandonment of his wife and children
|
|
PossPronRNP pron num cn rnp =
|
|
|
|
-- : NP -> Prep -> RNP -> RNP ; -- a dispute with his wife
|
|
AdvRAP adv rp =
|
|
|
|
-- : VP -> Prep -> RNP -> VP ; -- lectured about her travels
|
|
AdvRNP adv rp =
|
|
|
|
-- : AP -> Prep -> RNP -> AP ; -- adamant in his refusal
|
|
AdvRVP adv rp =
|
|
-}
|
|
|
|
oper
|
|
possPron : Agr => Str = table {
|
|
Ag Sg P1 => "minu" ;
|
|
Ag Sg P2 => "sinu" ;
|
|
Ag Sg P3 => "tema" ;
|
|
Ag Pl P1 => "meie" ;
|
|
Ag Pl P2 => "teie" ;
|
|
Ag Pl P3 => "nende" ;
|
|
AgPol => "teie"
|
|
} ;
|
|
|
|
|
|
---------------------------------
|
|
-- A - B
|
|
lin
|
|
|
|
|
|
AdAdV ad adv = AdAdv ad adv ;
|
|
|
|
-- : AP -> CN ; -- a green one ; en grön (Swe)
|
|
AdjAsCN ap = emptyCN ** {s = ap.s ! True} ; -- True = attributive ; False = predicative
|
|
|
|
-- : AP -> NP
|
|
AdjAsNP ap = MassNP (AdjAsCN ap) ;
|
|
|
|
-- : NP -> NP -> NP
|
|
ApposNP np1 np2 = np2 ** {
|
|
s = \\nf => np1.s ! nf ++ np2.s ! nf ; -- comma or not?
|
|
} ;
|
|
|
|
-- : Adv -> NP -> Cl ; -- here is the tree / here are the trees
|
|
AdvIsNP adv np = mkClause (\_ -> adv.s) (agrP3 Sg) (UseComp (CompNP np)) ;
|
|
|
|
-- : A2 -> VPSlash
|
|
A2VPSlash a2 = UseComp (CompAP (UseA2 a2)) ** {c2 = a2.c2} ;
|
|
|
|
-- : VP -> Adv ;
|
|
ByVP = GerundAdv ;
|
|
|
|
---------------------------------
|
|
-- C
|
|
|
|
lin
|
|
|
|
-- : VS -> S -> VP ;
|
|
ComplBareVS v s = insertExtrapos s.s (predV v) ;
|
|
|
|
-- : N -> N -> N ; -- control system / controls system / control-system
|
|
CompoundN noun cn = cn ** {
|
|
s = \\nf => noun.s ! NCase Sg Gen ++ BIND ++ cn.s ! nf
|
|
} ;
|
|
|
|
-- : N -> A -> AP ; -- language independent / language-independent
|
|
CompoundAP n a = PositA (a ** {s = \\d,af => n.s ! NCase Sg Nom ++ BIND ++ a.s ! d ! af}) ;
|
|
|
|
-- : VS -> Utt -> VP ; -- say: "today"
|
|
ComplDirectVS vs utt = insertExtrapos (BIND ++ ":" ++ utt.s) (predV vs) ;
|
|
|
|
-- : VQ -> Utt -> VP ; -- ask: "when"
|
|
ComplDirectVQ vq utt = insertExtrapos (BIND ++ ":" ++ utt.s) (predV vq) ;
|
|
|
|
-- : S -> Comp ; -- (the fact is) that she sleeps
|
|
CompS s = {s = \\_ => "et" ++ s.s} ;
|
|
|
|
-- : QS -> Comp ; -- (the question is) who sleeps
|
|
CompQS qs = {s = \\_ => qs.s } ;
|
|
|
|
-- : Ant -> Pol -> VP -> Comp ; -- (she is) to go
|
|
CompVP ant pol vp = {s = \\a => infVPAnt ant.a (NPCase Nom) pol.p a vp InfDa } ;
|
|
|
|
|
|
-- ComplGenVV v a p vp = insertObj (\\agr => a.s ++ p.s ++ infVP v.typ vp a.a p.p agr)
|
|
-- (predVV v) ;
|
|
|
|
-- ComplSlashPartLast vps np = {} ; --- AR 7/3/2013
|
|
|
|
---------------------------------
|
|
-- E - F
|
|
|
|
lin
|
|
|
|
-- : VP -> SC ; -- looking at Mary (is fun) / filmide vaatamine (on tore) / ___ga abielus olemine,
|
|
EmbedPresPart vp = {s = infVP (NPCase Gen) Pos (agrP3 Sg) vp InfMine } ;
|
|
|
|
EmbedSSlash s = {s = s.s ++ s.c2.s} ;
|
|
|
|
-- : ClSlash -> RCl ; -- he lives in
|
|
EmptyRelSlash cls = {
|
|
s = \\t,a,p,_ => cls.s ! t ! a ! p ++ cls.c2.s ;
|
|
c = NPCase Nom
|
|
} ;
|
|
|
|
-- : CN -> Cl ; -- there is a car / there is no car ; there is beer / there is no beer ; there are
|
|
-- TODO: these all use the literal "exist" verb. Does Estonian have a construction for "there is"?
|
|
ExistCN, ExistMassCN = \cn -> ExistsNP (MassNP cn) ;
|
|
ExistPluralCN cn = ExistsNP (DetCN (DetQuant IndefArt NumPl) cn) ;
|
|
|
|
-- : NP -> Cl ; -- there exists a number / there exist numbers
|
|
ExistsNP = IdiomEst.ExistNP ;
|
|
|
|
-- : AP -> NP -> Utt ; -- green was the tree
|
|
FocusAP ap np =
|
|
let pred : VP = UseComp (CompNP np) ;
|
|
subj : NP = AdjAsNP ap ;
|
|
cl : Cl = PredVP subj pred ;
|
|
in UttS (UseCl (TTAnt TPres ASimul) PPos cl) ; -- use AdvIsNP for similar construction but that returns a Cl instead
|
|
|
|
-- : Ad[vV] -> S -> Utt -- today I will sleep
|
|
FocusAdV, FocusAdv = \adv,s -> cc2 adv s ;
|
|
|
|
-- : NP -> SSlash -> Utt ; -- her I love
|
|
FocusObj np sslash = {s = appCompl True Pos sslash.c2 np ++ sslash.s} ;
|
|
|
|
|
|
-- : NP -> VS -> Utt -> Cl ; -- "I am here", she said
|
|
FrontComplDirectVS np vs utt =
|
|
let cl : Cl = PredVP np (UseV vs) ;
|
|
in cl ** {s = \\t,a,p => utt.s ++ bindComma ++ cl.s ! t ! a ! p} ;
|
|
|
|
-- : NP -> VQ -> Utt -> Cl ; -- "where", she asked
|
|
FrontComplDirectVQ np vq utt =
|
|
let cl : Cl = PredVP np (UseV vq) ;
|
|
in cl ** {s = \\t,a,p => utt.s ++ bindComma ++ cl.s ! t ! a ! p} ;
|
|
|
|
|
|
---------------------------------
|
|
-- G
|
|
|
|
lin
|
|
-- : NP -> Quant ; -- this man's
|
|
GenNP np = {
|
|
s,sp = \\_,_ => linNP (NPCase Gen) np ;
|
|
isNum = False ;
|
|
isDef = True ;
|
|
isNeg = False
|
|
} ;
|
|
|
|
-- : IP -> IQuant ; -- whose
|
|
GenIP ip = {s = \\_,_ => linIP (NPCase Gen) ip} ;
|
|
|
|
-- : Num -> CN -> RP ; -- whose car
|
|
GenRP num cn = {
|
|
s = \\n,c => let k = npform2case num.n c
|
|
in relPron ! NCase n Gen ++ cn.s ! NCase num.n k ;
|
|
a = RNoAg
|
|
} ;
|
|
|
|
-- In case the first two are not available, the following applications should in any case be.
|
|
|
|
-- : Num -> NP -> CN -> NP ; -- this man's car(s)
|
|
GenModNP num np cn = DetCN (DetQuant (GenNP (lin NP np)) num) cn ;
|
|
|
|
-- : Num -> IP -> CN -> IP ; -- whose car(s)
|
|
GenModIP num ip cn = IdetCN (IdetQuant (GenIP (lin IP ip)) num) cn ;
|
|
|
|
-- : VP -> Adv
|
|
GerundAdv vp = {s = infVPdefault vp InfDes} ;
|
|
|
|
-- : VP -> CN -- publishing of the document (can get a determiner)
|
|
GerundCN vp = emptyCN ** {
|
|
s = \\nf => infVPdefault vp {stem = InfM ; suf = []}
|
|
++ ine.s ! nf ;
|
|
} where {
|
|
ine : N = mkN "ine" "ise" "ist" "isesse" "iste" "isi"
|
|
} ;
|
|
-- : VP -> NP -- publishing the document (by nature definite)
|
|
GerundNP vp = MassNP (GerundCN vp) ;
|
|
|
|
---------------------------------
|
|
-- I - N
|
|
|
|
lin
|
|
|
|
-- : AP -> IComp ; -- "how old"
|
|
ICompAP ap = icompAP "kui" ap ;
|
|
|
|
-- : Adv -> IAdv ; -- "how often"
|
|
IAdvAdv adv = { s = "kui" ++ adv.s } ;
|
|
|
|
-- : VP -> Adv -- et raamatut paremini näha
|
|
InOrderToVP vp = {s = "et" ++ infVPdefault vp InfDa} ;
|
|
|
|
-- : N2 -> VPSlash
|
|
N2VPSlash n2 = UseComp (CompCN (UseN2 n2)) ** {c2 = n2.c2} ;
|
|
|
|
-- : VPSlash -> NP -> NP ; publishing of the document
|
|
-- NominalizeVPSlashNP vpslash np = {} ;
|
|
|
|
|
|
---------------------------------
|
|
-- P
|
|
|
|
lin
|
|
|
|
-- : VPSlash -> NP -> VP ; -- be begged by her to go
|
|
PassAgentVPSlash vps np = let vp : VP = PassVPSlash vps in vp ** {
|
|
adv = vp.adv ++ appCompl True Pos by8agent_Prep np ;
|
|
} ;
|
|
|
|
|
|
-- : VPSlash -> VP ; -- be forced to sleep
|
|
PassVPSlash vps = vps ** {
|
|
s = \\vf => case vf of {
|
|
VIFin t => vps.s ! VIPass t ;
|
|
x => vps.s ! x } ;
|
|
sc = compl2subjcase vps.c2
|
|
} ;
|
|
|
|
-- : VPSlash -> AP ; -- täna leitud
|
|
PastPartAP vp = {
|
|
s = \\_,_ => vp2adv <lin VP vp : VP> True (PastPart Pass) ;
|
|
infl = Invariable
|
|
} ;
|
|
|
|
-- : VP -> AP ; -- (the man) looking at Mary / filme vaatav (mees)
|
|
PresPartAP vp = {
|
|
s = \\_,_ => vp2adv vp True VIPresPart ;
|
|
infl = Invariable
|
|
} ;
|
|
|
|
-- : VPSlash -> NP -> AP -- hobisukeldujate poolt leitud (süvaveepomm)
|
|
PastPartAgentAP vp np = {
|
|
s = \\_,_ => appCompl True Pos by8agent_Prep np
|
|
++ vp2adv <lin VP vp : VP> True (PastPart Pass) ;
|
|
infl = Invariable
|
|
} ;
|
|
|
|
PositAdVAdj = PositAdvAdj ;
|
|
|
|
-- : AP -> VP -> Cl ; -- it is good to walk / on hea kõndida
|
|
PredAPVP ap vp =
|
|
let heaOllaVP : VP = lin VP (insertObj (\\_,_,_ => ap.s ! True ! NCase Sg Nom) vp) ; -- puts AP into the s2 field
|
|
heaOllaComp : Comp = CompVP ASimul PPos heaOllaVP ; -- chooses InfDa, fixes word order
|
|
heaOlla : VP = UseComp heaOllaComp -- looks silly, but I want to reuse the abstract syntax funs :-P
|
|
in existClause noSubj (agrP3 Sg) heaOlla ;
|
|
|
|
-- : IAdv -> VP -> QCl ; -- how to walk?
|
|
PredIAdvVP iadv vp = {s = \\t,a,p => iadv.s ++ infVPdefault vp InfMa} ;
|
|
|
|
PrepCN prep cn = PrepNP prep (MassNP cn) ;
|
|
|
|
ProDrop pron = pron ** {s = \\_ => []} ;
|
|
|
|
ProgrVPSlash vps = ProgrVP vps ** vps ;
|
|
|
|
PurposeVP = InOrderToVP ; --- is there a difference?
|
|
|
|
oper
|
|
-- calling infVP with the "default arguments": NPCase Nom, Pos, agrP3 Sg
|
|
infVPdefault : VP -> InfForms -> Str = infVP (NPCase Nom) Pos (agrP3 Sg) ;
|
|
|
|
vp2adv = overload {
|
|
|
|
vp2adv : R.VP -> Bool -> VIForm -> Str = \vp,sentIsPos,vif ->
|
|
let vpforms : {fin,inf : Str} = case vif of {
|
|
VIInf if => applyInfFormsVP {stem=if ; suf="a"} vp ; --- this oper shouldn't be used if you want to use an InfForm but just trying to be robust here
|
|
_ => mkVPForms vp.v ! vif ! Simul ! Pos ! agrP3 Sg} ;
|
|
in vp.s2 ! sentIsPos ! Pos ! agrP3 Sg -- raamatut
|
|
++ vp.adv -- paremini
|
|
++ vp.p -- ära
|
|
++ vpforms.fin -- tunda/tundes/tundmata/...
|
|
++ vpforms.inf -- TODO is this necessary???
|
|
++ vp.ext ;
|
|
vp2adv : R.VP -> Bool -> VForm -> Str = \vp,sentIsPos,vf ->
|
|
vp.s2 ! sentIsPos ! Pos ! agrP3 Sg -- raamatut
|
|
++ vp.adv -- paremini
|
|
++ vp.p -- ära
|
|
++ vp.v.s ! vf -- tuntud
|
|
++ vp.ext
|
|
} ;
|
|
---------------------------------
|
|
-- S - W
|
|
|
|
lin
|
|
|
|
-- SlashBareV2S v s = insertExtrapos s.s (predV v) ** v ;
|
|
|
|
UseDAP,
|
|
UseDAPFem,
|
|
UseDAPMasc = DetNP ;
|
|
|
|
UttAccIP ip = {s = linIP NPAcc ip} ;
|
|
UttAccNP np = {s = linNP NPAcc np} ;
|
|
UttAdV adv = adv ;
|
|
UttDatIP ip = {s = linIP (NPCase Part) ip} ; -- is partitive a reasonable translation?
|
|
UttDatNP np = {s = linNP (NPCase Part) np} ;
|
|
|
|
-- : VP -> Utt ; -- There's no "short form", so just using InfDa instead of InfMa
|
|
UttVPShort vp = {s = infVPdefault vp InfDa} ;
|
|
|
|
-- : VP -> Adv ; -- ilma raamatut nägemata
|
|
WithoutVP vp = {s = "ilma" ++ infVPdefault vp InfMata} ;
|
|
|
|
}
|