mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-08 02:32:50 -06:00
moved development-phrase modules to subdir alternatives
This commit is contained in:
aarne
142
lib/src/experimental/alternatives/Predication.gf
Normal file
142
lib/src/experimental/alternatives/Predication.gf
Normal file
@@ -0,0 +1,142 @@
|
||||
abstract Predication = {
|
||||
|
||||
flags
|
||||
startcat = Utt ;
|
||||
|
||||
cat
|
||||
Arg ;
|
||||
V Arg ;
|
||||
VP Arg ;
|
||||
VPC Arg ; -- conjunction of VP
|
||||
Ant ;
|
||||
Tense ;
|
||||
Pol ;
|
||||
Cl Arg ;
|
||||
ClC Arg ; -- conjunction of Cl
|
||||
QCl Arg ;
|
||||
NP ;
|
||||
Adv Arg ; -- preposition is Adv aNP
|
||||
S ;
|
||||
Utt ;
|
||||
AP Arg ;
|
||||
CN Arg ; -- the country he became the president of
|
||||
IP ;
|
||||
Conj ;
|
||||
IAdv ;
|
||||
|
||||
fun
|
||||
aNone, aS, aV, aQ, aA, aN : Arg ;
|
||||
aNP : Arg -> Arg ;
|
||||
TPres, TPast, TFut, TCond : Tense ;
|
||||
PPos, PNeg : Pol ;
|
||||
ASimul, AAnter : Ant ;
|
||||
|
||||
UseV : Ant -> Tense -> Pol -> (a : Arg) -> V a -> VP a ;
|
||||
PassUseV : Ant -> Tense -> Pol -> (a : Arg) -> V (aNP a) -> VP a ;
|
||||
AgentPassUseV : Ant -> Tense -> Pol -> (a : Arg) -> V (aNP a) -> NP -> VP a ;
|
||||
|
||||
SlashV2 : (a : Arg) -> VP (aNP a) -> NP -> VP a ; -- consuming first NP
|
||||
SlashV3 : (a : Arg) -> VP (aNP (aNP a)) -> NP -> VP (aNP a) ; -- consuming second NP
|
||||
ComplVS : (a : Arg) -> VP aS -> Cl a -> VP a ;
|
||||
ComplVV : (a : Arg) -> VP aV -> VP a -> VP a ;
|
||||
ComplVQ : (a : Arg) -> VP aQ -> QCl a -> VP a ;
|
||||
ComplVA : (a : Arg) -> VP aA -> AP a -> VP a ;
|
||||
ComplVN : (a : Arg) -> VP aN -> CN a -> VP a ;
|
||||
SlashV2S : (a : Arg) -> VP (aNP aS) -> Cl a -> VP (aNP a) ; -- a:Arg gives slash propagation, SlashVS
|
||||
SlashV2V : (a : Arg) -> VP (aNP aV) -> VP a -> VP (aNP a) ;
|
||||
SlashV2A : (a : Arg) -> VP (aNP aA) -> AP a -> VP (aNP a) ;
|
||||
SlashV2N : (a : Arg) -> VP (aNP aN) -> CN a -> VP (aNP a) ;
|
||||
SlashV2Q : (a : Arg) -> VP (aNP aA) -> QCl a -> VP (aNP a) ;
|
||||
|
||||
UseAP : Ant -> Tense -> Pol -> (a : Arg) -> AP a -> VP a ;
|
||||
|
||||
PredVP : (a : Arg) -> NP -> VP a -> Cl a ;
|
||||
|
||||
SlashClNP : (a : Arg) -> Cl (aNP a) -> NP -> Cl a ; -- slash consumption: hon tittar på + oss
|
||||
|
||||
ReflVP : (a : Arg) -> VP (aNP a) -> VP a ; -- refl on first position (direct object)
|
||||
ReflVP2 : (a : Arg) -> VP (aNP (aNP a)) -> VP (aNP a) ; -- refl on second position (indirect object)
|
||||
|
||||
QuestVP : (a : Arg) -> IP -> VP a -> QCl a ;
|
||||
QuestSlash : (a : Arg) -> IP -> QCl (aNP a) -> QCl a ;
|
||||
QuestCl : (a : Arg) -> Cl a -> QCl a ;
|
||||
QuestIAdv : (a : Arg) -> IAdv -> Cl a -> QCl a ;
|
||||
|
||||
UseCl : Cl aNone -> S ;
|
||||
UseQCl : QCl aNone -> S ; -- deprecate QS
|
||||
|
||||
UseAdvCl : Adv aNone -> Cl aNone -> S ; -- lift adv to front
|
||||
|
||||
UttS : S -> Utt ;
|
||||
|
||||
-- when to add adverbs
|
||||
|
||||
---- AdvVP : Adv -> (a : Arg) -> VP a -> VP a ; ---- these create many ambiguities
|
||||
---- "hon tvingar oss att sova idag": 196 parses, 13s. With AdvVP restricted to top level: 32 parses, 7s
|
||||
---- with AdvCl, just 16 parses, 0.2 s
|
||||
|
||||
AdvCl : (a : Arg) -> Adv a -> Cl aNone -> Cl a ;
|
||||
|
||||
AdvQCl : (a : Arg) -> Adv a -> QCl aNone -> QCl a ;
|
||||
|
||||
|
||||
-- participles as adjectives
|
||||
|
||||
PresPartAP : (a : Arg) -> V a -> AP a ;
|
||||
PastPartAP : (a : Arg) -> V (aNP a) -> AP a ;
|
||||
AgentPastPartAP : (a : Arg) -> V (aNP a) -> NP -> AP a ;
|
||||
|
||||
-- VP coordination
|
||||
|
||||
StartVPC : Conj -> (a : Arg) -> VP a -> VP a -> VPC a ;
|
||||
ContVPC : (a : Arg) -> VP a -> VPC a -> VPC a ;
|
||||
UseVPC : (a : Arg) -> VPC a -> VP a ;
|
||||
|
||||
-- clause coordination, including "she loves and we look at (her)"
|
||||
StartClC : Conj -> (a : Arg) -> Cl a -> Cl a -> ClC a ;
|
||||
ContClC : (a : Arg) -> Cl a -> ClC a -> ClC a ;
|
||||
UseClC : (a : Arg) -> ClC a -> Cl a ;
|
||||
|
||||
ComplAdv : (a : Arg) -> Adv (aNP a) -> NP -> Adv a ; -- typically: formation of preposition phrase
|
||||
|
||||
--------------- from now on, to be inherited from standard RGL; here just for test purposes
|
||||
|
||||
|
||||
-- lexicon
|
||||
|
||||
sleep_V : V aNone ;
|
||||
walk_V : V aNone ;
|
||||
love_V2 : V (aNP aNone) ;
|
||||
look_V2 : V (aNP aNone) ;
|
||||
believe_VS : V aS ;
|
||||
tell_V2S : V (aNP aS) ;
|
||||
prefer_V3 : V (aNP (aNP aNone)) ;
|
||||
want_VV : V aV ;
|
||||
force_V2V : V (aNP aV) ;
|
||||
promise_V2V : V (aNP aV) ;
|
||||
wonder_VQ : V aQ ;
|
||||
become_VA : V aA ;
|
||||
become_VN : V aN ;
|
||||
make_V2A : V (aNP aA) ;
|
||||
ask_V2Q : V (aNP aQ) ;
|
||||
promote_V2N : V (aNP aN) ;
|
||||
|
||||
old_A : AP aNone ;
|
||||
married_A2 : AP (aNP aNone) ; -- married to her
|
||||
eager_AV : AP aV ; -- eager to sleep
|
||||
easy_A2V : AP (aNP aV) ; -- easy for him to sleep
|
||||
professor_N : CN aNone ;
|
||||
manager_N2 : CN (aNP aNone) ; -- manager of X
|
||||
|
||||
she_NP : NP ;
|
||||
we_NP : NP ;
|
||||
|
||||
today_Adv : Adv aNone ;
|
||||
always_AdV : Adv aNone ;
|
||||
who_IP : IP ;
|
||||
|
||||
with_Prep : Adv (aNP aNone) ;
|
||||
and_Conj : Conj ;
|
||||
why_IAdv : IAdv ;
|
||||
|
||||
}
|
||||
766
lib/src/experimental/alternatives/PredicationEng.gf
Normal file
766
lib/src/experimental/alternatives/PredicationEng.gf
Normal file
@@ -0,0 +1,766 @@
|
||||
concrete PredicationEng of Predication = open Prelude in {
|
||||
|
||||
-- English predication, based on Swedish
|
||||
-- two principles:
|
||||
-- - keep records discontinuous as long as possible (last step from Cl to S)
|
||||
-- - select from tables as soon as possible (first step from V to VP)
|
||||
-- a question: would it make sense to make this into a functor?
|
||||
|
||||
---------------------
|
||||
-- parameters -------
|
||||
---------------------
|
||||
|
||||
-- standard general
|
||||
param
|
||||
Number = Sg | Pl ;
|
||||
Person = P1 | P2 | P3 ;
|
||||
Anteriority = Simul | Anter ;
|
||||
Polarity = Pos | Neg ;
|
||||
STense = Pres | Past | Fut | Cond ;
|
||||
Voice = Act | Pass ;
|
||||
Unit = UUnit ;
|
||||
|
||||
-- predication specific
|
||||
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
|
||||
|
||||
-- standard English
|
||||
Gender = Neutr | Masc | Fem ;
|
||||
Agr = AgP1 Number | AgP2 Number | AgP3Sg Gender | AgP3Pl ;
|
||||
Case = Nom | Acc ;
|
||||
NPCase = NCase Case | NPAcc | NPNomPoss ;
|
||||
VForm = VInf | VPres | VPast | VPPart | VPresPart ;
|
||||
|
||||
-- language dependent
|
||||
VAgr = VASgP1 | VASgP3 | VAPl ;
|
||||
|
||||
oper
|
||||
subjCase : NPCase = NCase Nom ;
|
||||
objCase : NPCase = NPAcc ;
|
||||
|
||||
agentCase : ComplCase = "by" ;
|
||||
|
||||
ComplCase = Str ; -- preposition
|
||||
|
||||
appComplCase : ComplCase -> NounPhrase -> Str = \p,np -> p ++ np.s ! objCase ;
|
||||
noComplCase : ComplCase = [] ;
|
||||
prepComplCase : Preposition -> ComplCase = \p -> p.s ;
|
||||
|
||||
noObj : Agr => Str = \\_ => [] ;
|
||||
|
||||
NAgr = Number ;
|
||||
AAgr = Unit ;
|
||||
IPAgr = Number ;
|
||||
|
||||
defaultAgr : Agr = AgP3Sg Neutr ;
|
||||
|
||||
-- omitting rich Agr information
|
||||
agr2vagr : Agr -> VAgr = \a -> case a of {
|
||||
AgP1 Sg => VASgP1 ;
|
||||
AgP3Sg _ => VASgP3 ;
|
||||
_ => VAPl
|
||||
} ;
|
||||
|
||||
agr2aagr : Agr -> AAgr = \n -> UUnit ;
|
||||
|
||||
agr2nagr : Agr -> NAgr = \a -> case a of {
|
||||
AgP1 n => n ;
|
||||
AgP2 n => n ;
|
||||
AgP3Sg _ => Sg ;
|
||||
AgP3Pl => Pl
|
||||
} ;
|
||||
|
||||
-- restoring full Agr
|
||||
ipagr2agr : IPAgr -> Agr = \n -> case n of {
|
||||
Sg => AgP3Sg Neutr ; ---- gender
|
||||
Pl => AgP3Pl
|
||||
} ;
|
||||
|
||||
ipagr2vagr : IPAgr -> VAgr = \n -> case n of {
|
||||
Sg => VASgP3 ;
|
||||
Pl => VAPl
|
||||
} ;
|
||||
|
||||
--- this is only needed in VPC formation
|
||||
vagr2agr : VAgr -> Agr = \a -> case a of {
|
||||
VASgP1 => AgP1 Sg ;
|
||||
VASgP3 => AgP3Sg Neutr ;
|
||||
VAPl => AgP3Pl
|
||||
} ;
|
||||
|
||||
vPastPart : AAgr -> VForm = \_ -> VPPart ;
|
||||
vPresPart : AAgr -> VForm = \_ -> VPresPart ;
|
||||
|
||||
------------------------------------
|
||||
-- lincats
|
||||
-------------------------------------
|
||||
|
||||
-- standard general
|
||||
lincat
|
||||
Tense = {s : Str ; t : STense} ;
|
||||
Ant = {s : Str ; a : Anteriority} ;
|
||||
Pol = {s : Str ; p : Polarity} ;
|
||||
Utt = {s : Str} ;
|
||||
IAdv = {s : Str} ;
|
||||
|
||||
-- predication-specific
|
||||
Arg = {s : Str} ;
|
||||
|
||||
V = {
|
||||
v : VForm => Str ;
|
||||
p : Str ; -- verb particle
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
isSubjectControl : Bool ;
|
||||
isAux : Bool ;
|
||||
isRefl : Bool ;
|
||||
} ;
|
||||
|
||||
oper
|
||||
VerbPhrase = {
|
||||
v : VAgr => Str * Str * Str ; -- would,have,slept
|
||||
inf : Str * Str ; -- have,slept
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
part : Str ; -- (look) up
|
||||
adj : Agr => Str ;
|
||||
obj1 : (Agr => Str) * Agr ; -- agr for object control
|
||||
obj2 : (Agr => Str) * Bool ; -- subject control = True
|
||||
adv : Str ;
|
||||
adV : Str ;
|
||||
ext : Str ;
|
||||
qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions
|
||||
} ;
|
||||
|
||||
Clause = {
|
||||
v : Str * Str * Str ;
|
||||
inf : Str * Str ;
|
||||
adj,obj1,obj2 : Str ;
|
||||
adv : Str ;
|
||||
adV : Str ;
|
||||
ext : Str ;
|
||||
subj : Str ;
|
||||
c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency
|
||||
qforms : Str * Str
|
||||
} ;
|
||||
|
||||
lincat
|
||||
VP = VerbPhrase ;
|
||||
Cl = Clause ;
|
||||
|
||||
QCl = Clause ** {
|
||||
foc : Str ; -- the focal position at the beginning: *who* does she love
|
||||
focType : FocusType ; --- if already filled, then use other place: who loves *who*
|
||||
} ;
|
||||
|
||||
VPC = {
|
||||
v : VAgr => Str ;
|
||||
inf : Agr => Str ;
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase
|
||||
} ;
|
||||
|
||||
ClC = {
|
||||
s : Str ;
|
||||
c3 : ComplCase ;
|
||||
} ;
|
||||
|
||||
Adv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
|
||||
S = {s : Str} ;
|
||||
|
||||
AP = {
|
||||
s : AAgr => Str ;
|
||||
c1, c2 : ComplCase ;
|
||||
obj1 : Agr => Str
|
||||
} ;
|
||||
|
||||
CN = {
|
||||
s : NAgr => Str ;
|
||||
c1, c2 : ComplCase ;
|
||||
obj1 : Agr => Str
|
||||
} ;
|
||||
|
||||
-- language specific
|
||||
|
||||
NP = NounPhrase ;
|
||||
IP = {s : NPCase => Str ; n : IPAgr} ; ---- n : Number in Eng
|
||||
Conj = {s1,s2 : Str ; n : Number} ;
|
||||
|
||||
oper
|
||||
NounPhrase = {s : NPCase => Str ; a : Agr} ;
|
||||
Preposition = {s : Str} ;
|
||||
|
||||
----------------------------
|
||||
--- linearization rules ----
|
||||
----------------------------
|
||||
|
||||
-- standard general
|
||||
|
||||
lin
|
||||
TPres = {s = [] ; t = Pres} ;
|
||||
TPast = {s = [] ; t = Past} ;
|
||||
TFut = {s = [] ; t = Fut} ;
|
||||
TCond = {s = [] ; t = Cond} ;
|
||||
ASimul = {s = [] ; a = Simul} ;
|
||||
AAnter = {s = [] ; a = Anter} ;
|
||||
PPos = {s = [] ; p = Pos} ;
|
||||
PNeg = {s = [] ; p = Neg} ;
|
||||
|
||||
-- predication specific
|
||||
|
||||
aNone, aS, aV, aA, aQ, aN = {s = []} ;
|
||||
aNP a = a ;
|
||||
|
||||
UseV a t p _ v = {
|
||||
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Act agr v ;
|
||||
inf = tenseInfV a.s a.a p.p Act v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
part = v.p ;
|
||||
adj = noObj ;
|
||||
obj1 = <case v.isRefl of {True => \\a => reflPron ! a ; False => \\_ => []}, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, v.isSubjectControl> ;
|
||||
adV = negAdV p ; --- just p.s in Eng
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
|
||||
} ;
|
||||
|
||||
PassUseV a t p _ v = {
|
||||
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ;
|
||||
inf = tenseInfV a.s a.a p.p Pass v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
part = v.p ;
|
||||
adj = noObj ;
|
||||
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
|
||||
adV = negAdV p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
} ;
|
||||
|
||||
AgentPassUseV a t p _ v np = {
|
||||
v = \\agr => tenseV (a.s ++ t.s ++ p.s) t.t a.a p.p Pass agr v ;
|
||||
inf = tenseInfV a.s a.a p.p Pass v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
part = v.p ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj, True> ;
|
||||
adV = negAdV p ;
|
||||
adv = appComplCase agentCase np ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
} ;
|
||||
|
||||
UseAP a t p _ ap = {
|
||||
v = \\agr => be_Aux (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
inf = tenseInfV a.s a.a p.p Act be_V ;
|
||||
c1 = ap.c1 ;
|
||||
c2 = ap.c2 ;
|
||||
part = [] ;
|
||||
adj = \\a => ap.s ! agr2aagr a ;
|
||||
obj1 = <ap.obj1, defaultAgr> ;
|
||||
obj2 = <noObj, True> ; --- there are no A3's
|
||||
adV = negAdV p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
|
||||
} ;
|
||||
|
||||
SlashV2 x vp np = vp ** {
|
||||
obj1 : (Agr => Str) * Agr = <\\a => np.s ! objCase, np.a> -- np.a for object control
|
||||
} ;
|
||||
|
||||
SlashV3 x vp np = addObj2VP vp (\\a => np.s ! objCase) ; -- control is preserved
|
||||
|
||||
ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
|
||||
|
||||
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
|
||||
|
||||
ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm
|
||||
|
||||
ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
|
||||
|
||||
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cnForm
|
||||
|
||||
SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
|
||||
|
||||
SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form
|
||||
|
||||
SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm
|
||||
|
||||
SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
|
||||
|
||||
SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form
|
||||
|
||||
ReflVP x vp = vp ** {
|
||||
obj1 : (Agr => Str) * Agr = <\\a => reflPron ! a, defaultAgr> ; --- defaultAgr will not be used but subj.a instead
|
||||
} ;
|
||||
|
||||
ReflVP2 x vp = vp ** {
|
||||
obj2 : (Agr => Str) * Bool = <\\a => reflPron ! a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
|
||||
} ;
|
||||
|
||||
PredVP x np vp = vp ** {
|
||||
v = vp.v ! agr2vagr np.a ;
|
||||
subj = np.s ! subjCase ;
|
||||
adj = vp.adj ! np.a ;
|
||||
obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase ---- place of part depends on obj
|
||||
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase
|
||||
c3 = noComplCase ; -- for one more prep to build ClSlash
|
||||
qforms = vp.qforms ! agr2vagr np.a ;
|
||||
} ;
|
||||
|
||||
PrepCl p x cl = cl ** { -- Cl/NP ::= Cl PP/NP
|
||||
c3 = prepComplCase p ;
|
||||
} ;
|
||||
|
||||
SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP
|
||||
adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added
|
||||
c3 = noComplCase ; -- complCase has been consumed
|
||||
} ;
|
||||
|
||||
|
||||
-- QCl ::= Cl by just adding focus field
|
||||
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: does she love us
|
||||
|
||||
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: why does she love us
|
||||
|
||||
QuestVP x ip vp = let ipa = ipagr2agr ip.n in
|
||||
vp ** {
|
||||
v = vp.v ! ipagr2vagr ip.n ;
|
||||
foc = ip.s ! subjCase ; -- who (loves her)
|
||||
focType = FocSubj ;
|
||||
subj = [] ;
|
||||
adj = vp.adj ! ipa ;
|
||||
obj1 = vp.part ++ vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase
|
||||
obj2 = 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?
|
||||
qforms = vp.qforms ! ipagr2vagr ip.n ;
|
||||
} ;
|
||||
|
||||
QuestSlash x ip cl =
|
||||
let
|
||||
prep = cl.c3 ;
|
||||
ips = ip.s ! objCase ; -- 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 => <[], 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 ;
|
||||
} ;
|
||||
{-
|
||||
---- this is giving four records instead of two AR 5/2/2014
|
||||
|
|
||||
cl ** { -- pied piping
|
||||
foc = focobj.p4 ++ focobj.p1 ;
|
||||
focType = focobj.p3 ;
|
||||
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
|
||||
c3 = noComplCase ;
|
||||
} ;
|
||||
-}
|
||||
|
||||
UseCl cl = {s = declCl cl} ;
|
||||
UseQCl cl = {s = questCl cl} ;
|
||||
|
||||
UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
|
||||
|
||||
UttS s = s ;
|
||||
|
||||
AdvCl x a cl = case a.isAdV of {
|
||||
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
|
||||
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
|
||||
} ;
|
||||
|
||||
AdvQCl x a cl = case a.isAdV of {
|
||||
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
|
||||
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
|
||||
} ;
|
||||
|
||||
|
||||
PresPartAP x v = {
|
||||
s = \\a => v.v ! vPresPart a ;
|
||||
c1 = v.c1 ; -- looking at her
|
||||
c2 = v.c2 ;
|
||||
obj1 = noObj ;
|
||||
} ;
|
||||
|
||||
PastPartAP x v = {
|
||||
s = \\a => v.v ! vPastPart a ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
obj1 = noObj ;
|
||||
} ;
|
||||
|
||||
AgentPastPartAP x v np = {
|
||||
s = \\a => v.v ! vPastPart a ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
|
||||
} ;
|
||||
|
||||
StartVPC c 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 ++
|
||||
v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase
|
||||
++ c.s2 ++
|
||||
wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase
|
||||
w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ;
|
||||
inf = \\a =>
|
||||
infVP a (lin VP v) ++ c.s2 ++ infVP a (lin VP w) ;
|
||||
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
|
||||
c2 = [] ; ---- w.c2 ?
|
||||
} ;
|
||||
|
||||
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
|
||||
v = \\a => <[], [], vpc.v ! a> ;
|
||||
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
|
||||
c1 = vpc.c1 ;
|
||||
c2 = vpc.c2 ;
|
||||
part = [] ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj,True> ;
|
||||
adv,adV = [] ;
|
||||
ext = [] ;
|
||||
qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did
|
||||
} ;
|
||||
|
||||
StartClC c x a b = {
|
||||
s = declCl (lin Cl a) ++ c.s2 ++ declCl (lin Cl b) ;
|
||||
c3 = b.c3 ; ----
|
||||
} ;
|
||||
|
||||
UseClC x cl = {
|
||||
subj = [] ;
|
||||
v = <[],[],cl.s> ; ----
|
||||
inf = <[],[]> ;
|
||||
adj = [] ;
|
||||
obj1 = [] ;
|
||||
obj2 = [] ;
|
||||
adV = [] ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
c3 = cl.c3 ;
|
||||
qforms = <[],[]> ; ---- qforms
|
||||
} ;
|
||||
|
||||
ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ;
|
||||
|
||||
|
||||
---- the following may become parameters for a functor
|
||||
|
||||
oper
|
||||
|
||||
be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; p,c1,c2 = [] ; isAux = True ; isSubjectControl,isRefl = False} ;
|
||||
|
||||
negAdV : Pol -> Str = \p -> p.s ;
|
||||
|
||||
reflPron : Agr => Str = table {
|
||||
AgP1 Sg => "myself" ;
|
||||
AgP2 Sg => "yourself" ;
|
||||
AgP3Sg Masc => "himself" ;
|
||||
AgP3Sg Fem => "herself" ;
|
||||
AgP3Sg Neutr => "itself" ;
|
||||
AgP1 Pl => "ourselves" ;
|
||||
AgP2 Pl => "yourselves" ;
|
||||
AgP3Pl => "themselves"
|
||||
} ;
|
||||
|
||||
infVP : Agr -> VP -> Str = \a,vp ->
|
||||
let
|
||||
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
|
||||
in
|
||||
vp.adV ++ vp.inf.p1 ++ vp.inf.p2 ++ vp.part ++
|
||||
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
|
||||
|
||||
qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str =
|
||||
\sta,t,a,p,agr,v ->
|
||||
let
|
||||
verb = tenseActV sta t a Neg agr v ;
|
||||
averb = tenseActV sta t a p agr v
|
||||
in case <v.isAux, t, a> of {
|
||||
<False,Pres|Past,Simul> => case p of {
|
||||
Pos => < verb.p1, verb.p3> ; -- does , sleep
|
||||
Neg => < verb.p1, verb.p2> -- does , not sleep ---- TODO: doesn't , sleep
|
||||
} ;
|
||||
_ => <averb.p1, averb.p2>
|
||||
} ;
|
||||
|
||||
qformsBe : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
|
||||
\sta,t,a,p,agr ->
|
||||
let verb = be_AuxL sta t a p agr
|
||||
in <verb.p1, verb.p2> ; -- is , not ---- TODO isn't ,
|
||||
|
||||
tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> VAgr -> V -> Str * Str * Str =
|
||||
\sta,t,a,p,o,agr,v ->
|
||||
case o of {
|
||||
Act => tenseActV sta t a p agr v ;
|
||||
Pass => tensePassV sta t a p agr v
|
||||
} {-
|
||||
| ---- leaving out these variants makes compilation time go down from 900ms to 300ms.
|
||||
---- parsing time of "she sleeps" goes down from 300ms to 60ms. 4/2/2014
|
||||
case o of {
|
||||
Act => tenseActVContracted sta t a p agr v ;
|
||||
Pass => tensePassVContracted sta t a p agr v
|
||||
-} ;
|
||||
|
||||
tenseActV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
|
||||
let vt : VForm = case <t,agr> of {
|
||||
<Pres,VASgP3> => VPres ;
|
||||
<Past|Cond,_ > => VPast ;
|
||||
_ => VInf
|
||||
} ;
|
||||
in
|
||||
case <t,a> of {
|
||||
<Pres|Past, Simul> =>
|
||||
case v.isAux of {
|
||||
True => <sta ++ v.v ! vt, [], []> ;
|
||||
False => case p of {
|
||||
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
|
||||
Neg => <do_Aux vt Pos, not_Str p, sta ++ v.v ! VInf>
|
||||
}
|
||||
} ;
|
||||
|
||||
<Pres|Past, Anter> => <have_Aux vt Pos, not_Str p, sta ++ v.v ! VPPart> ;
|
||||
<Fut|Cond, Simul> => <will_Aux vt Pos, not_Str p, sta ++ v.v ! VInf> ;
|
||||
<Fut|Cond, Anter> => <will_Aux vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPPart>
|
||||
} ;
|
||||
|
||||
tenseActVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
|
||||
let vt : VForm = case <t,agr> of {
|
||||
<Pres,VASgP3> => VPres ;
|
||||
<Past|Cond,_ > => VPast ;
|
||||
_ => VInf
|
||||
} ;
|
||||
in
|
||||
|
||||
case <t,a> of {
|
||||
<Pres|Past, Simul> =>
|
||||
case v.isAux of {
|
||||
True => <sta ++ v.v ! vt, [], []> ;
|
||||
False => case p of {
|
||||
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
|
||||
Neg => <do_Aux vt p, [], sta ++ v.v ! VInf>
|
||||
}
|
||||
} ;
|
||||
<Pres|Past, Anter> => <have_AuxC vt p, [], sta ++ v.v ! VPPart>
|
||||
| <have_AuxC vt Pos, not_Str p, sta ++ v.v ! VPPart> ;
|
||||
<Fut|Cond, Simul> => <will_AuxC vt p, [], sta ++ v.v ! VInf>
|
||||
| <will_AuxC vt Pos, not_Str p, sta ++ v.v ! VInf> ;
|
||||
<Fut|Cond, Anter> => <will_AuxC vt p, have_Aux VInf Pos, sta ++ v.v ! VPPart>
|
||||
| <will_AuxC vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPPart>
|
||||
} ;
|
||||
|
||||
tensePassV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
|
||||
let
|
||||
be = be_AuxL sta t a p agr ;
|
||||
done = v.v ! VPPart
|
||||
in
|
||||
<be.p1, be.p2, be.p3 ++ done> ;
|
||||
tensePassVContracted : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str * Str = \sta,t,a,p,agr,v ->
|
||||
let
|
||||
be = be_AuxC sta t a p agr ;
|
||||
done = v.v ! VPPart
|
||||
in
|
||||
<be.p1, be.p2, be.p3 ++ done> ;
|
||||
|
||||
tenseInfV : Str -> Anteriority -> Polarity -> Voice -> V -> Str * Str = \sa,a,p,o,v ->
|
||||
case a of {
|
||||
Simul => <[], sa ++ v.v ! VInf> ; -- (she wants to) sleep
|
||||
Anter => <have_Aux VInf Pos, sa ++ v.v ! VPPart> -- (she wants to) have slept
|
||||
} ;
|
||||
|
||||
----- dangerous variants for PMCFG generation - keep apart as long as possible
|
||||
be_Aux : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
|
||||
be_AuxL sta t a p agr | be_AuxC sta t a p agr ;
|
||||
be_AuxL : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
|
||||
let
|
||||
beV = tenseActV sta t a p agr be_V
|
||||
in
|
||||
case <t,a,p,agr> of {
|
||||
<Pres,Simul,Pos,VASgP3> => <"is" ++ sta, [], []> ;
|
||||
<Pres,Simul,Pos,VASgP1> => <"am" ++ sta, [], []> ;
|
||||
<Pres,Simul,Pos,VAPl> => <"are" ++ sta, [], []> ;
|
||||
<Pres,Simul,Neg,VASgP3> => <"is" ++ sta, "not", []> ;
|
||||
<Pres,Simul,Neg,VASgP1> => <"am" ++ sta, "not", []> ;
|
||||
<Pres,Simul,Neg,VAPl> => <"are" ++ sta, "not", []> ;
|
||||
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
|
||||
<Past,Simul,Neg,VAPl> => <"were" ++ sta, "not", []> ;
|
||||
<Past,Simul,Neg,_> => <"was" ++ sta, "not", []> ;
|
||||
_ => beV
|
||||
} ;
|
||||
be_AuxC : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str * Str = \sta,t,a,p,agr ->
|
||||
let
|
||||
beV = tenseActVContracted sta t a p agr be_V
|
||||
in
|
||||
case <t,a,p,agr> of {
|
||||
<Pres,Simul,Pos,VASgP3> => <Predef.BIND ++ "'s" ++ sta, [], []> ;
|
||||
<Pres,Simul,Pos,VASgP1> => <Predef.BIND ++ "'m" ++ sta, [], []> ;
|
||||
<Pres,Simul,Pos,VAPl> => <Predef.BIND ++ "'re" ++ sta, [], []> ;
|
||||
<Pres,Simul,Neg,VASgP3> => <Predef.BIND ++ "'s" ++ sta, "not", []>
|
||||
| <"isn't" ++ sta, [], []> ;
|
||||
<Pres,Simul,Neg,VASgP1> => <Predef.BIND ++ "'m" ++ sta, "not", []> ;
|
||||
<Pres,Simul,Neg,VAPl> => <Predef.BIND ++ "'re" ++ sta, "not", []>
|
||||
| <"aren't" ++ sta, [], []> ;
|
||||
<Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
|
||||
<Past,Simul,Neg,VAPl> => <"weren't" ++ sta, [], []> ;
|
||||
<Past,Simul,Neg,_> => <"wasn't" ++ sta, [], []> ;
|
||||
_ => beV
|
||||
} ;
|
||||
|
||||
declCl : Clause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
declSubordCl : Clause -> Str = declCl ;
|
||||
declInvCl : Clause -> Str = declCl ;
|
||||
|
||||
questCl : QCl -> Str = \cl -> case cl.focType of {
|
||||
NoFoc => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- does she sleep
|
||||
FocObj => cl.foc ++ cl.qforms.p1 ++ cl.subj ++ cl.adV ++ cl.qforms.p2 ++ restCl cl ; -- who does she love
|
||||
FocSubj => cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl -- who loves her
|
||||
} ;
|
||||
|
||||
questSubordCl : QCl -> Str = \cl ->
|
||||
let
|
||||
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ cl.v.p2 ++ restCl cl
|
||||
in case cl.focType of {
|
||||
NoFoc => "if" ++ cl.foc ++ rest ; -- om she sleeps
|
||||
FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps
|
||||
FocSubj => cl.foc ++ rest -- who loves her
|
||||
} ;
|
||||
|
||||
that_Compl : Str = "that" | [] ;
|
||||
|
||||
-- this part is usually the same in all reconfigurations
|
||||
restCl : Clause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ;
|
||||
|
||||
|
||||
addObj2VP : VerbPhrase -> (Agr => Str) -> VerbPhrase = \vp,obj -> vp ** {
|
||||
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
|
||||
} ;
|
||||
|
||||
addExtVP : VerbPhrase -> Str -> VerbPhrase = \vp,ext -> vp ** {
|
||||
ext = ext ;
|
||||
} ;
|
||||
|
||||
|
||||
|
||||
|
||||
---- the lexicon is just for testing: use standard Eng lexicon and morphology instead
|
||||
|
||||
lin
|
||||
sleep_V = mkV "sleep" "slept" "slept" [] [] ;
|
||||
walk_V = mkV "walk" ;
|
||||
love_V2 = mkV "love" ;
|
||||
look_V2 = mkV "look" "at" [] ;
|
||||
believe_VS = mkV "believe" ;
|
||||
tell_V2S = mkV "tell" "told" "told" [] [] ;
|
||||
prefer_V3 = mkV "prefer" [] "to" ;
|
||||
want_VV = mkV "want" [] "to" ;
|
||||
force_V2V = mkV "force" [] "to" ;
|
||||
--- promise_V2V = mkV "promise" [] "to" ** {isSubjectControl = True} ;
|
||||
wonder_VQ = mkV "wonder" ;
|
||||
become_VA = mkV "become" "became" "become" [] [] ;
|
||||
become_VN = mkV "become" "became" "become" [] [] ;
|
||||
make_V2A = mkV "make" "made" "made" [] [] ;
|
||||
promote_V2N = mkV "promote" [] "to" ;
|
||||
ask_V2Q = mkV "ask" ;
|
||||
|
||||
old_A = {s = \\_ => "old" ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
married_A2 = {s = \\_ => "married" ; c1 = "to" ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
eager_AV = {s = \\_ => "eager" ; c1 = [] ; c2 = "to" ; obj1 = \\_ => []} ;
|
||||
easy_A2V = {s = \\_ => "easy" ; c1 = "for" ; c2 = "to" ; obj1 = \\_ => []} ;
|
||||
|
||||
professor_N = {s = table {Sg => "professor" ; Pl => "professors"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
manager_N2 = {s = table {Sg => "manager" ; Pl => "managers"} ; c1 = "for" ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
|
||||
she_NP = {s = table {NCase Nom => "she" ; _ => "her"} ; a = AgP3Sg Fem} ;
|
||||
we_NP = {s = table {NCase Nom => "we" ; _ => "us"} ; a = AgP1 Pl} ;
|
||||
|
||||
today_Adv = {s = "today" ; isAdV = False ; c1 = []} ;
|
||||
always_AdV = {s = "always" ; isAdV = True ; c1 = []} ;
|
||||
|
||||
who_IP = {s = \\_ => "who" ; n = Sg} ;
|
||||
|
||||
with_Prep = {s = [] ; c1 = "with" ; isAdV = False} ;
|
||||
|
||||
and_Conj = {s1 = [] ; s2 = "and" ; n = Pl} ;
|
||||
|
||||
why_IAdv = {s = "why"} ;
|
||||
|
||||
oper
|
||||
mkV = overload {
|
||||
mkV : Str -> V = \s -> lin V {v = mkVerb s (s + "s") (edV s) (edV s) (ingV s) ; p,c1,c2 = [] ; isAux,isSubjectControl,isRefl = False} ;
|
||||
mkV : Str -> Str -> Str -> V = \s,p,q -> lin V {v = mkVerb s (s + "s") (edV s) (edV s) (ingV s) ; p = [] ; c1 = p ; c2 = q ; isAux,isSubjectControl,isRefl = False} ;
|
||||
mkV : Str -> Str -> Str -> Str -> Str -> V = \s,t,u,p,q -> lin V {v = mkVerb s (s + "s") t u (ingV s) ; p = [] ; c1 = p ; c2 = q ; isAux,isSubjectControl,isRefl = False} ;
|
||||
} ;
|
||||
|
||||
mkVerb : Str -> Str -> Str -> Str -> Str -> VForm => Str = \go,goes,went,gone,going -> table {
|
||||
VInf => go ;
|
||||
VPres => goes ;
|
||||
VPast => went ;
|
||||
VPPart => gone ;
|
||||
VPresPart => going
|
||||
} ;
|
||||
|
||||
edV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ed" ;
|
||||
ingV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ing" ;
|
||||
|
||||
---- have to split the tables to two to get reasonable PMCFG generation
|
||||
will_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
|
||||
<VInf|VPres, Pos> => varAux "will" "ll" ;
|
||||
<VInf|VPres, Neg> => "won't" ;
|
||||
<VPast|_ , Pos> => varAux "would" "d" ;
|
||||
<VPast|_ , Neg> => "wouldn't"
|
||||
} ;
|
||||
will_AuxC : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
|
||||
<VInf|VPres, Pos> => varAuxC "will" "ll" ;
|
||||
<VInf|VPres, Neg> => "won't" ;
|
||||
<VPast|_ , Pos> => varAuxC "would" "d" ;
|
||||
<VPast|_ , Neg> => "wouldn't"
|
||||
} ;
|
||||
|
||||
have_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
|
||||
<VInf, Pos> => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive
|
||||
<VInf, Neg> => "haven't" ;
|
||||
<VPres, Pos> => varAux "has" "s" ;
|
||||
<VPres, Neg> => "hasn't" ;
|
||||
<VPast|_ , Pos> => varAux "had" "d" ;
|
||||
<VPast|_ , Neg> => "hadn't"
|
||||
} ;
|
||||
have_AuxC : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
|
||||
<VInf, Pos> => varAuxC "have" "ve" ; --- slightly overgenerating if used in infinitive
|
||||
<VInf, Neg> => "haven't" ;
|
||||
<VPres, Pos> => varAuxC "has" "s" ;
|
||||
<VPres, Neg> => "hasn't" ;
|
||||
<VPast|_ , Pos> => varAuxC "had" "d" ;
|
||||
<VPast|_ , Neg> => "hadn't"
|
||||
} ;
|
||||
|
||||
do_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
|
||||
<VInf, Pos> => "do" ;
|
||||
<VInf, Neg> => "don't" ;
|
||||
<VPres, Pos> => "does" ;
|
||||
<VPres, Neg> => "doesn't" ;
|
||||
<VPast|_ , Pos> => "did" ;
|
||||
<VPast|_ , Neg> => "didn't"
|
||||
} ;
|
||||
|
||||
varAux : Str -> Str -> Str = \long,short -> long ; ----| Predef.BIND ++ ("'" + short) ;
|
||||
varAuxC : Str -> Str -> Str = \long,short -> Predef.BIND ++ ("'" + short) ;
|
||||
|
||||
not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ;
|
||||
|
||||
}
|
||||
697
lib/src/experimental/alternatives/PredicationSwO.gf
Normal file
697
lib/src/experimental/alternatives/PredicationSwO.gf
Normal file
@@ -0,0 +1,697 @@
|
||||
concrete PredicationSwO of Predication = open Prelude in {
|
||||
|
||||
-- Swedish predication: simpler and purer than English.
|
||||
-- two principles:
|
||||
-- - keep records discontinuous as long as possible (last step from Cl to S)
|
||||
-- - select from tables as soon as possible (first step from V to VP)
|
||||
-- a question: would it make sense to make this into a functor?
|
||||
|
||||
param
|
||||
Agr = Sg | Pl ;
|
||||
Case = Nom | Acc ;
|
||||
STense = Pres | Past | Perf | Fut ;
|
||||
Anteriority = Simul | Anter ;
|
||||
Polarity = Pos | Neg ;
|
||||
VTense = VInf | VPres | VPret | VSup ;
|
||||
VForm = TV Voice VTense | PastPart Agr | PresPart ;
|
||||
Voice = Act | Pass ;
|
||||
|
||||
|
||||
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
|
||||
|
||||
oper
|
||||
defaultAgr = Sg ;
|
||||
ComplCase = Str ; -- preposition
|
||||
|
||||
lincat
|
||||
Arg = {s : Str} ;
|
||||
|
||||
V = {
|
||||
v : VForm => Str ;
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
isSubjectControl : Bool ;
|
||||
} ;
|
||||
|
||||
VP = {
|
||||
v : Str * Str * Str ; -- ska,ha,sovit
|
||||
inf : Str * Str ; -- ha,sovit
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
adj : Agr => Str ;
|
||||
obj1 : (Agr => Str) * Agr ;
|
||||
obj2 : (Agr => Str) * Bool ; -- subject control = True
|
||||
adv : Str ;
|
||||
adV : Str ;
|
||||
ext : Str
|
||||
} ;
|
||||
|
||||
oper Clause = {
|
||||
v : Str * Str * Str ;
|
||||
inf : Str * Str ;
|
||||
adj,obj1,obj2 : Str ;
|
||||
adv : Str ;
|
||||
adV : Str ;
|
||||
ext : Str ;
|
||||
subj : Str ;
|
||||
c3 : ComplCase -- for a slashed adjunct, not belonging to the verb valency
|
||||
} ;
|
||||
|
||||
lincat
|
||||
Cl = Clause ;
|
||||
|
||||
QCl = Clause ** {
|
||||
foc : Str ; -- the focal position at the beginning, e.g. *vem* älskar hon
|
||||
focType : FocusType ; --- if already filled, then use other place: vem älskar *vem*
|
||||
} ;
|
||||
|
||||
VPC = {
|
||||
v : Agr => Str ;
|
||||
inf : Agr => Str ;
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase
|
||||
} ;
|
||||
|
||||
ClC = {
|
||||
s : Str ;
|
||||
c3 : ComplCase ;
|
||||
} ;
|
||||
|
||||
Tense = {s : Str ; t : STense} ;
|
||||
Ant = {s : Str ; a : Anteriority} ;
|
||||
Pol = {s : Str ; p : Polarity} ;
|
||||
|
||||
NP = {s : Case => Str ; a : Agr} ;
|
||||
Adv = {s : Str} ;
|
||||
AdV = {s : Str} ;
|
||||
S = {s : Str} ;
|
||||
Utt = {s : Str} ;
|
||||
AP = {
|
||||
s : Agr => Str ;
|
||||
c1, c2 : ComplCase ;
|
||||
obj1 :
|
||||
Agr => Str
|
||||
} ;
|
||||
CN = {
|
||||
s : Agr => Str ;
|
||||
c1, c2 : ComplCase ;
|
||||
obj1 :
|
||||
Agr => Str
|
||||
} ;
|
||||
IP = {s : Str ; a : Agr} ;
|
||||
Prep = {s : Str} ;
|
||||
Conj = {s : Str} ;
|
||||
IAdv = {s : Str} ;
|
||||
|
||||
lin
|
||||
aNone, aS, aV, aA, aQ, aN = {s = []} ;
|
||||
aNP a = a ;
|
||||
|
||||
TPres = {s = [] ; t = Pres} ;
|
||||
TPast = {s = [] ; t = Past} ;
|
||||
TFut = {s = [] ; t = Fut} ;
|
||||
TCond = {s = [] ; t = Perf} ;
|
||||
ASimul = {s = [] ; a = Simul} ;
|
||||
AAnter = {s = [] ; a = Anter} ;
|
||||
|
||||
PPos = {s = [] ; p = Pos} ;
|
||||
PNeg = {s = [] ; p = Neg} ;
|
||||
|
||||
UseV a t p _ v = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Act v ;
|
||||
inf = tenseInfV a.s a.a Act v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
adj = noObj ;
|
||||
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, v.isSubjectControl> ;
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
PassUseV a t p _ v = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
|
||||
inf = tenseInfV a.s a.a Pass v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
adj = noObj ;
|
||||
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
AgentPassUseV a t p _ v np = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
|
||||
inf = tenseInfV a.s a.a Pass v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj, True> ;
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = appComplCase agentCase np ; ---- add a specific field for agent?
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
UseAP a t p _ ap = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Act be_V ;
|
||||
inf = tenseInfV a.s a.a Act be_V ;
|
||||
c1 = ap.c1 ;
|
||||
c2 = ap.c2 ;
|
||||
adj = \\a => ap.s ! a ;
|
||||
obj1 = <ap.obj1, defaultAgr> ;
|
||||
obj2 = <noObj, True> ; --- there are no A3's
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
SlashV2 x vp np = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ; ---- should be consumed now
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = <\\a => np.s ! Acc, np.a> ; -- np.a for object control ---- Acc to be abstracted
|
||||
obj2 = vp.obj2 ;
|
||||
adv = vp.adv ;
|
||||
adV = vp.adV ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
SlashV3 x vp np = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- should be consumed now
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => np.s ! Acc, vp.obj2.p2> ; -- control is preserved ---- Acc to be abstracted
|
||||
adv = vp.adv ;
|
||||
adV = vp.adV ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
ComplVS x vp cl = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ; ---- consumed
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = that_Compl ++ declSubordCl (lin Cl cl) ; ---- sentence form
|
||||
} ;
|
||||
|
||||
ComplVQ x vp qcl = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ; ---- consumed
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = questSubordCl qcl ; ---- question form
|
||||
} ;
|
||||
|
||||
ComplVV x vp vpo = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => infVP a vpo, vp.obj2.p2> ; ---- infForm
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
ComplVA x vp ap = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ; ---- consumed
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => ap.s ! a ++ ap.obj1 ! a, vp.obj2.p2> ; ---- adjForm
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
ComplVN x vp cn = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ; ---- consumed
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => cn.s ! a ++ cn.obj1 ! a, vp.obj2.p2> ; ---- cnForm
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
SlashV2S x vp cl = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- consumed
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = that_Compl ++ declSubordCl (lin Cl cl) ; ---- sentence form
|
||||
} ;
|
||||
|
||||
SlashV2Q x vp cl = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- consumed
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = questSubordCl (lin QCl cl) ; ---- question form
|
||||
} ;
|
||||
|
||||
SlashV2V x vp vpo = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- consumed
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => infVP a (lin VP vpo), vp.obj2.p2> ; ---- infForm
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
SlashV2A x vp ap = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- consumed
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => ap.s ! a ++ ap.obj1 ! a, vp.obj2.p2> ; ---- adjForm
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
SlashV2N x vp cn = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- consumed
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => cn.s ! a ++ cn.obj1 ! a, vp.obj2.p2> ; ---- cn form
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
ReflVP x vp = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ; ---- consumed
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
ReflVP2 x vp = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ; ---- consumed
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
PredVP x np vp = {
|
||||
subj = np.s ! Nom ;
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
adj = vp.adj ! np.a ;
|
||||
obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase
|
||||
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
c3 = noComplCase ; -- for one more prep to build ClSlash
|
||||
} ;
|
||||
|
||||
PrepCl p x cl = { -- Cl/NP ::= Cl PP/NP
|
||||
subj = cl.subj ;
|
||||
v = cl.v ;
|
||||
inf = cl.inf ;
|
||||
adj = cl.adj ;
|
||||
obj1 = cl.obj1 ;
|
||||
obj2 = cl.obj2 ;
|
||||
adV = cl.adV ;
|
||||
adv = cl.adv ;
|
||||
ext = cl.ext ;
|
||||
c3 = prepComplCase p ;
|
||||
} ;
|
||||
|
||||
SlashClNP x cl np = { -- Cl ::= Cl/NP NP
|
||||
subj = cl.subj ;
|
||||
v = cl.v ;
|
||||
inf = cl.inf ;
|
||||
adj = cl.adj ;
|
||||
obj1 = cl.obj1 ;
|
||||
obj2 = cl.obj2 ;
|
||||
adV = cl.adV ;
|
||||
adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added
|
||||
ext = cl.ext ;
|
||||
c3 = noComplCase ; -- complCase has been consumed
|
||||
} ;
|
||||
|
||||
|
||||
-- QCl ::= Cl by just adding focus field
|
||||
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: älskar hon oss
|
||||
|
||||
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför älskar hon oss
|
||||
|
||||
QuestVP x ip vp = {
|
||||
foc = ip.s ; -- vem älskar henne
|
||||
focType = FocSubj ;
|
||||
subj = [] ;
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
adj = vp.adj ! ip.a ;
|
||||
obj1 = vp.c1 ++ vp.obj1.p1 ! ip.a ; ---- appComplCase
|
||||
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ip.a ; False => vp.obj1.p2}) ; ---- appComplCase
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
|
||||
} ;
|
||||
|
||||
QuestSlash x ip cl =
|
||||
let
|
||||
ips = cl.c3 ++ ip.s ; -- in Cl/NP, c3 is the only prep ---- appComplCase for ip
|
||||
focobj = case cl.focType of {
|
||||
NoFoc => <ips, [], FocObj> ; -- put ip object to focus if there is no focus yet
|
||||
t => <[], ips, t> -- put ip object in situ if there already is a focus
|
||||
} ;
|
||||
in {
|
||||
foc = focobj.p1 ;
|
||||
focType = focobj.p3 ;
|
||||
subj = cl.subj ;
|
||||
v = cl.v ;
|
||||
inf = cl.inf ;
|
||||
adj = cl.adj ;
|
||||
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
|
||||
obj2 = cl.obj2 ; ---- slash to this part? maybe with one more value of focType?
|
||||
adV = cl.adV ;
|
||||
adv = cl.adv ;
|
||||
ext = cl.ext ;
|
||||
c3 = noComplCase ;
|
||||
} ;
|
||||
|
||||
UseCl cl = {s = declCl cl} ;
|
||||
UseQCl cl = {s = questCl cl} ;
|
||||
|
||||
UttS s = s ;
|
||||
|
||||
AdvCl a x cl = {
|
||||
subj = cl.subj ;
|
||||
v = cl.v ;
|
||||
inf = cl.inf ;
|
||||
adj = cl.adj ;
|
||||
obj1 = cl.obj1 ;
|
||||
obj2 = cl.obj2 ;
|
||||
adV = cl.adV ;
|
||||
adv = cl.adv ++ a.s ;
|
||||
ext = cl.ext ;
|
||||
c3 = cl.c3 ;
|
||||
} ;
|
||||
|
||||
AdVCl a x cl = {
|
||||
subj = cl.subj ;
|
||||
v = cl.v ;
|
||||
inf = cl.inf ;
|
||||
adj = cl.adj ;
|
||||
obj1 = cl.obj1 ;
|
||||
obj2 = cl.obj2 ;
|
||||
adV = cl.adV ++ a.s ;
|
||||
adv = cl.adv ;
|
||||
ext = cl.ext ;
|
||||
c3 = cl.c3 ;
|
||||
} ;
|
||||
|
||||
|
||||
{-
|
||||
AdvVP adv x vp = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ;
|
||||
adv = vp.adv ++ adv.s ; ---- all adverbs become one field - how to front one of them?
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
|
||||
AdVVP adv _ vp = {
|
||||
v = vp.v ;
|
||||
inf = vp.inf ;
|
||||
c1 = vp.c1 ;
|
||||
c2 = vp.c2 ;
|
||||
adj = vp.adj ;
|
||||
obj1 = vp.obj1 ;
|
||||
obj2 = vp.obj2 ;
|
||||
adV = vp.adV ++ adv.s ; ---- all adV's become one field - how to front one of them?
|
||||
adv = vp.adv ;
|
||||
ext = vp.ext ;
|
||||
} ;
|
||||
-}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
PresPartAP x v = {
|
||||
s = \\a => v.v ! PresPart ;
|
||||
c1 = v.c1 ; -- tittande på henne
|
||||
c2 = v.c2 ;
|
||||
obj1 = noObj ;
|
||||
} ;
|
||||
|
||||
PastPartAP x v = {
|
||||
s = \\a => v.v ! PastPart a ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
obj1 = noObj ;
|
||||
} ;
|
||||
|
||||
AgentPastPartAP x v np = {
|
||||
s = \\a => v.v ! PastPart a ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
|
||||
} ;
|
||||
|
||||
StartVPC c x v w = { ---- some loss of quality seems inevitable
|
||||
v = \\a =>
|
||||
v.v.p1 ++ v.adV ++ v.v.p2 ++ v.v.p3 ++ v.adj ! a ++
|
||||
v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase
|
||||
++ c.s ++
|
||||
w.v.p1 ++ w.adV ++ w.v.p2 ++ w.v.p3 ++ w.adj ! a ++ ---- appComplCase
|
||||
w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ;
|
||||
inf = \\a =>
|
||||
infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ;
|
||||
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
|
||||
c2 = [] ; ---- w.c2 ?
|
||||
} ;
|
||||
|
||||
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
|
||||
v = <[], [], vpc.v ! defaultAgr> ; ---- agreement
|
||||
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
|
||||
c1 = vpc.c1 ;
|
||||
c2 = vpc.c2 ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj,True> ;
|
||||
adv,adV = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
StartClC c x a b = {
|
||||
s = declCl (lin Cl a) ++ c.s ++ declCl (lin Cl b) ;
|
||||
c3 = b.c3 ; ----
|
||||
} ;
|
||||
|
||||
UseClC x cl = {
|
||||
subj = [] ;
|
||||
v = <[],[],cl.s> ; ----
|
||||
inf = <[],[]> ;
|
||||
adj = [] ;
|
||||
obj1 = [] ;
|
||||
obj2 = [] ;
|
||||
adV = [] ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
c3 = cl.c3 ;
|
||||
} ;
|
||||
|
||||
---- the lexicon is just for testing: use standard Swe lexicon and morphology instead
|
||||
|
||||
sleep_V = mkV "sova" "sover" "sov" "sovit" "soven" "sovna" ;
|
||||
walk_V = mkV "gå" "går" "gick" "gått" "gången" "gångna" ;
|
||||
love_V2 = mkV "älska" "älskar" "älskade" "älskat" "älskad" "älskade" ;
|
||||
look_V2 = mkV "titta" "tittar" "tittade" "tittat" "tittad" "tittade" "på" [] ;
|
||||
believe_VS = mkV "tro" "tror" "trodde" "trott" "trodd" "trodda" ;
|
||||
tell_V2S = mkV "berätta" "berättar" "berättade" "berättat" "berättad" "berättade" "för" [] ;
|
||||
prefer_V3 = mkV "föredra" "föredrar" "föredrog" "föredragit" "föredragen" "föredragna" [] "framför" ;
|
||||
want_VV = mkV "vilja" "vill" "ville" "velat" "velad" "velade" ;
|
||||
force_V2V = let tvinga : V = mkV "tvinga" "tvingar" "tvingade" "tvingat" "tvingad" "tvingade" in
|
||||
{v = tvinga.v ; c1 = [] ; c2 = "att" ; isSubjectControl = False} ;
|
||||
promise_V2V = mkV "lova" "lovar" "lovade" "lovat" "lovad" "lovade" [] "att" ;
|
||||
wonder_VQ = mkV "undra" "undrar" "undrade" "undrat" "undrad" "undrade" ;
|
||||
become_VA = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
|
||||
become_VN = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
|
||||
make_V2A = let gora : V = mkV "göra" "gör" "gjorde" "gjort" "gjord" "gjorda" in
|
||||
{v = table {TV Pass VPres => "görs" ; f => gora.v ! f} ; c1 = [] ; c2 = [] ; isSubjectControl = False} ;
|
||||
promote_V2N = let befordra : V = mkV "befordra" "befordrar" "befordrade" "befordrat" "befordrad" "befordrade"
|
||||
in {v = befordra.v ; c1 = [] ; c2 = "till" ; isSubjectControl = False} ; ---- ? de befordrade dem till chefer för sig/dem
|
||||
ask_V2Q = mkV "fråga" "frågar" "frågade" "frågat" "frågad" "frågade" ;
|
||||
|
||||
old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
eager_AV = {s = table {Sg => "ivrig" ; Pl => "ivriga"} ; c1 = [] ; c2 = "att" ; obj1 = \\_ => []} ;
|
||||
easy_A2V = {s = table {Sg => "lätt" ; Pl => "lätta"} ; c1 = "för" ; c2 = "att" ; obj1 = \\_ => []} ;
|
||||
professor_N = {s = table {Sg => "professor" ; Pl => "professorer"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
manager_N2 = {s = table {Sg => "chef" ; Pl => "chefer"} ; c1 = "för" ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
|
||||
she_NP = {s = table {Nom => "hon" ; Acc => "henne"} ; a = Sg} ;
|
||||
we_NP = {s = table {Nom => "vi" ; Acc => "oss"} ; a = Pl} ;
|
||||
|
||||
today_Adv = {s = "idag"} ;
|
||||
always_AdV = {s = "alltid"} ;
|
||||
|
||||
who_IP = {s = "vem" ; a = Sg} ;
|
||||
|
||||
PrepNP p np = {s = p.s ++ np.s ! Acc} ;
|
||||
|
||||
with_Prep = {s = "med"} ;
|
||||
|
||||
and_Conj = {s = "och"} ;
|
||||
|
||||
why_IAdv = {s = "varför"} ;
|
||||
|
||||
oper
|
||||
mkV = overload {
|
||||
mkV : (x,y,z,u,v,w : Str) -> V = \x,y,z,u,v,w ->
|
||||
lin V {
|
||||
v = table {
|
||||
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
|
||||
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
|
||||
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
|
||||
} ;
|
||||
c1 = [] ; c2 = [] ; isSubjectControl = True} ;
|
||||
mkV : (x,y,z,u,v,w : Str) -> Str -> Str -> V = \x,y,z,u,v,w,p,q ->
|
||||
lin V {
|
||||
v = table {
|
||||
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
|
||||
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
|
||||
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
|
||||
} ;
|
||||
c1 = p ; c2 = q ; isSubjectControl = True} ;
|
||||
} ;
|
||||
|
||||
be_V : V = mkV "vara" "är" "var" "varit" "varen" "varna" ;
|
||||
|
||||
have_V : V = mkV "ha" "har" "hade" "haft" "havd" "havda" ;
|
||||
|
||||
shall_V : V = mkV "skola" "ska" "skulle" "skolat" "skolad" "skolade" ;
|
||||
|
||||
|
||||
---- the following may become parameters for a functor
|
||||
|
||||
neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ;
|
||||
|
||||
reflPron : Agr -> Str = \a -> case a of {Sg => "sig" ; Pl => "oss"} ;
|
||||
|
||||
infVP : Agr -> VP -> Str = \a,vp ->
|
||||
let
|
||||
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
|
||||
in
|
||||
vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit
|
||||
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
|
||||
|
||||
tenseV : Str -> STense -> Anteriority -> Voice -> V -> Str * Str * Str = \sta,t,a,o,v -> case <t,a> of { --- sta dummy s field of Ant and Tense
|
||||
<Pres,Simul> => <sta ++ v.v ! TV o VPres, [], []> ;
|
||||
<Past,Simul> => <sta ++ v.v ! TV o VPret, [], []> ;
|
||||
<Fut, Simul> => <shall_V.v ! TV Act VPres, [], sta ++ v.v ! TV o VInf> ;
|
||||
<Cond,Simul> => <shall_V.v ! TV Act VPret, [], sta ++ v.v ! TV o VInf> ;
|
||||
<Pres,Anter> => <[], have_V.v ! TV Act VPres, sta ++ v.v ! TV o VSup> ;
|
||||
<Past,Anter> => <[], have_V.v ! TV Act VPret, sta ++ v.v ! TV o VSup> ;
|
||||
<Fut, Anter> => <shall_V.v ! TV Act VPres, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup> ;
|
||||
<Cond,Anter> => <shall_V.v ! TV Act VPret, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup>
|
||||
} ;
|
||||
|
||||
tenseInfV : Str -> Anteriority -> Voice -> V -> Str * Str = \sa,a,o,v ->
|
||||
case a of {
|
||||
Simul => <[], sa ++ v.v ! TV o VInf> ; -- hon vill sova
|
||||
Anter => <have_V.v ! TV Act VInf, sa ++ v.v ! TV o VSup> -- hon vill (ha) sovit
|
||||
} ;
|
||||
|
||||
|
||||
declCl : Clause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
declSubordCl : Clause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
|
||||
declInvCl : Clause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
|
||||
questCl : QCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
|
||||
questSubordCl : QCl -> Str = \cl ->
|
||||
let
|
||||
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl
|
||||
in case cl.focType of {
|
||||
NoFoc => "om" ++ cl.foc ++ rest ; -- om hon sover
|
||||
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover
|
||||
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne
|
||||
} ;
|
||||
|
||||
that_Compl : Str = "att" | [] ;
|
||||
|
||||
-- this part is usually the same in all reconfigurations
|
||||
restCl : Clause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ;
|
||||
|
||||
agentCase : ComplCase = "av" ;
|
||||
|
||||
appComplCase : ComplCase -> NP -> Str = \p,np -> p ++ np.s ! Acc ;
|
||||
|
||||
noComplCase : ComplCase = [] ;
|
||||
|
||||
prepComplCase : Prep -> ComplCase = \p -> p.s ;
|
||||
|
||||
noObj : Agr => Str = \\_ => [] ;
|
||||
|
||||
}
|
||||
492
lib/src/experimental/alternatives/PredicationSwe.gf
Normal file
492
lib/src/experimental/alternatives/PredicationSwe.gf
Normal file
@@ -0,0 +1,492 @@
|
||||
concrete PredicationSwe of Predication = open Prelude in {
|
||||
|
||||
-- Swedish predication: simpler and purer than English.
|
||||
-- two principles:
|
||||
-- - keep records discontinuous as long as possible (last step from Cl to S)
|
||||
-- - select from tables as soon as possible (first step from V to VP)
|
||||
-- a question: would it make sense to make this into a functor?
|
||||
|
||||
param
|
||||
Agr = Sg | Pl ;
|
||||
Case = Nom | Acc ;
|
||||
STense = Pres | Past | Perf | Fut ;
|
||||
Anteriority = Simul | Anter ;
|
||||
Polarity = Pos | Neg ;
|
||||
VTense = VInf | VPres | VPret | VSup ;
|
||||
VForm = TV Voice VTense | PastPart Agr | PresPart ;
|
||||
Voice = Act | Pass ;
|
||||
|
||||
|
||||
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
|
||||
|
||||
oper
|
||||
defaultAgr = Sg ;
|
||||
ComplCase = Str ; -- preposition
|
||||
objCase = Acc ;
|
||||
|
||||
lincat
|
||||
Arg = {s : Str} ;
|
||||
|
||||
V = {
|
||||
v : VForm => Str ;
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
isSubjectControl : Bool ;
|
||||
} ;
|
||||
|
||||
VP = {
|
||||
v : Str * Str * Str ; -- ska,ha,sovit
|
||||
inf : Str * Str ; -- ha,sovit
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase ;
|
||||
adj : Agr => Str ;
|
||||
obj1 : (Agr => Str) * Agr ;
|
||||
obj2 : (Agr => Str) * Bool ; -- subject control = True
|
||||
adv : Str ;
|
||||
adV : Str ;
|
||||
ext : Str
|
||||
} ;
|
||||
|
||||
oper Clause = {
|
||||
v : Str * Str * Str ;
|
||||
inf : Str * Str ;
|
||||
adj,obj1,obj2 : Str ;
|
||||
adv : Str ;
|
||||
adV : Str ;
|
||||
ext : Str ;
|
||||
subj : Str ;
|
||||
c3 : ComplCase -- for a slashed adjunct, not belonging to the verb valency
|
||||
} ;
|
||||
|
||||
lincat
|
||||
Cl = Clause ;
|
||||
|
||||
QCl = Clause ** {
|
||||
foc : Str ; -- the focal position at the beginning, e.g. *vem* älskar hon
|
||||
focType : FocusType ; --- if already filled, then use other place: vem älskar *vem*
|
||||
} ;
|
||||
|
||||
VPC = {
|
||||
v : Agr => Str ;
|
||||
inf : Agr => Str ;
|
||||
c1 : ComplCase ;
|
||||
c2 : ComplCase
|
||||
} ;
|
||||
|
||||
ClC = {
|
||||
s : Str ;
|
||||
c3 : ComplCase ;
|
||||
} ;
|
||||
|
||||
Tense = {s : Str ; t : STense} ;
|
||||
Ant = {s : Str ; a : Anteriority} ;
|
||||
Pol = {s : Str ; p : Polarity} ;
|
||||
|
||||
NP = {s : Case => Str ; a : Agr} ;
|
||||
Adv = {s : Str ; isAdV : Bool ; c1 : ComplCase} ;
|
||||
S = {s : Str} ;
|
||||
Utt = {s : Str} ;
|
||||
AP = {
|
||||
s : Agr => Str ;
|
||||
c1, c2 : ComplCase ;
|
||||
obj1 :
|
||||
Agr => Str
|
||||
} ;
|
||||
CN = {
|
||||
s : Agr => Str ;
|
||||
c1, c2 : ComplCase ;
|
||||
obj1 :
|
||||
Agr => Str
|
||||
} ;
|
||||
IP = {s : Str ; a : Agr} ;
|
||||
Conj = {s : Str} ;
|
||||
IAdv = {s : Str} ;
|
||||
|
||||
lin
|
||||
aNone, aS, aV, aA, aQ, aN = {s = []} ;
|
||||
aNP a = a ;
|
||||
|
||||
TPres = {s = [] ; t = Pres} ;
|
||||
TPast = {s = [] ; t = Past} ;
|
||||
TFut = {s = [] ; t = Fut} ;
|
||||
TCond = {s = [] ; t = Perf} ;
|
||||
ASimul = {s = [] ; a = Simul} ;
|
||||
AAnter = {s = [] ; a = Anter} ;
|
||||
|
||||
PPos = {s = [] ; p = Pos} ;
|
||||
PNeg = {s = [] ; p = Neg} ;
|
||||
|
||||
UseV a t p _ v = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Act v ;
|
||||
inf = tenseInfV a.s a.a Act v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
adj = noObj ;
|
||||
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, v.isSubjectControl> ;
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
PassUseV a t p _ v = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
|
||||
inf = tenseInfV a.s a.a Pass v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
adj = noObj ;
|
||||
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
|
||||
obj2 = <noObj, True> ; -- becomes subject control even if object control otherwise "*she was promised by us to love ourselves"
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
AgentPassUseV a t p _ v np = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Pass v ;
|
||||
inf = tenseInfV a.s a.a Pass v ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj, True> ;
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = appComplCase agentCase np ; ---- add a specific field for agent?
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
UseAP a t p _ ap = {
|
||||
v = tenseV (a.s ++ t.s) t.t a.a Act be_V ;
|
||||
inf = tenseInfV a.s a.a Act be_V ;
|
||||
c1 = ap.c1 ;
|
||||
c2 = ap.c2 ;
|
||||
adj = \\a => ap.s ! a ;
|
||||
obj1 = <ap.obj1, defaultAgr> ;
|
||||
obj2 = <noObj, True> ; --- there are no A3's
|
||||
adV = p.s ++ neg p.p ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
SlashV2 x vp np = vp ** {
|
||||
obj1 : (Agr => Str) * Agr = <\\a => np.s ! Acc, np.a> -- np.a for object control ---- Acc to be abstracted
|
||||
} ;
|
||||
|
||||
SlashV3 x vp np = addObj2VP vp (\\a => np.s ! Acc) ; -- control is preserved ---- Acc to be abstracted
|
||||
|
||||
ComplVS x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
|
||||
|
||||
ComplVQ x vp qcl = addExtVP vp (questSubordCl qcl) ; ---- question form
|
||||
|
||||
ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm
|
||||
|
||||
ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! a ++ ap.obj1 ! a) ; ---- adjForm
|
||||
|
||||
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cnForm
|
||||
|
||||
SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
|
||||
|
||||
SlashV2Q x vp cl = addExtVP vp (questSubordCl (lin QCl cl)) ; ---- question form
|
||||
|
||||
SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm
|
||||
|
||||
SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! a ++ ap.obj1 ! a) ; ---- adjForm
|
||||
|
||||
SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cn form
|
||||
|
||||
ReflVP x vp = vp ** {
|
||||
obj1 : (Agr => Str) * Agr = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead
|
||||
} ;
|
||||
|
||||
ReflVP2 x vp = vp ** {
|
||||
obj2 : (Agr => Str) * Bool = <\\a => reflPron a, vp.obj2.p2> ; --- subj/obj control doesn't matter any more
|
||||
} ;
|
||||
|
||||
PredVP x np vp = vp ** {
|
||||
subj = np.s ! Nom ;
|
||||
adj = vp.adj ! np.a ;
|
||||
obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase
|
||||
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => np.a ; False => vp.obj1.p2}) ; ---- apply complCase
|
||||
c3 = noComplCase ; -- for one more prep to build ClSlash
|
||||
} ;
|
||||
|
||||
SlashClNP x cl np = cl ** { -- Cl ::= Cl/NP NP
|
||||
adv = cl.adv ++ appComplCase cl.c3 np ; ---- again, adv just added
|
||||
c3 = noComplCase ; -- complCase has been consumed
|
||||
} ;
|
||||
|
||||
|
||||
-- QCl ::= Cl by just adding focus field
|
||||
QuestCl x cl = cl ** {foc = [] ; focType = NoFoc} ; -- NoFoc implies verb first: älskar hon oss
|
||||
|
||||
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför älskar hon oss
|
||||
|
||||
QuestVP x ip vp = vp ** {
|
||||
foc = ip.s ; -- vem älskar henne
|
||||
focType = FocSubj ;
|
||||
subj = [] ;
|
||||
adj = vp.adj ! ip.a ;
|
||||
obj1 = vp.c1 ++ vp.obj1.p1 ! ip.a ; ---- appComplCase
|
||||
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ip.a ; False => vp.obj1.p2}) ; ---- appComplCase
|
||||
c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
|
||||
} ;
|
||||
|
||||
|
||||
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 => <[], 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 ;
|
||||
} ;
|
||||
{-
|
||||
---- this is giving four records instead of two AR 5/2/2014
|
||||
|
|
||||
cl ** { -- pied piping
|
||||
foc = focobj.p4 ++ focobj.p1 ;
|
||||
focType = focobj.p3 ;
|
||||
obj1 = cl.obj1 ++ focobj.p2 ; ---- just add to a field?
|
||||
c3 = noComplCase ;
|
||||
} ;
|
||||
-}
|
||||
|
||||
|
||||
|
||||
UseCl cl = {s = declCl cl} ;
|
||||
UseQCl cl = {s = questCl cl} ;
|
||||
|
||||
UseAdvCl adv cl = {s = adv.s ++ declInvCl cl} ;
|
||||
|
||||
UttS s = s ;
|
||||
|
||||
AdvCl x a cl = case a.isAdV of {
|
||||
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
|
||||
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
|
||||
} ;
|
||||
|
||||
AdvQCl x a cl = case a.isAdV of {
|
||||
True => cl ** {adV = cl.adV ++ a.s ; adv = cl.adv ; c3 = a.c1} ;
|
||||
False => cl ** {adv = cl.adv ++ a.s ; adV = cl.adV ; c3 = a.c1}
|
||||
} ;
|
||||
|
||||
PresPartAP x v = {
|
||||
s = \\a => v.v ! PresPart ;
|
||||
c1 = v.c1 ; -- tittande på henne
|
||||
c2 = v.c2 ;
|
||||
obj1 = noObj ;
|
||||
} ;
|
||||
|
||||
PastPartAP x v = {
|
||||
s = \\a => v.v ! PastPart a ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
obj1 = noObj ;
|
||||
} ;
|
||||
|
||||
AgentPastPartAP x v np = {
|
||||
s = \\a => v.v ! PastPart a ;
|
||||
c1 = v.c1 ;
|
||||
c2 = v.c2 ;
|
||||
obj1 = \\_ => appComplCase agentCase np ; ---- addObj
|
||||
} ;
|
||||
|
||||
StartVPC c x v w = { ---- some loss of quality seems inevitable
|
||||
v = \\a =>
|
||||
v.v.p1 ++ v.adV ++ v.v.p2 ++ v.v.p3 ++ v.adj ! a ++
|
||||
v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase
|
||||
++ c.s ++
|
||||
w.v.p1 ++ w.adV ++ w.v.p2 ++ w.v.p3 ++ w.adj ! a ++ ---- appComplCase
|
||||
w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ;
|
||||
inf = \\a =>
|
||||
infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ;
|
||||
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
|
||||
c2 = [] ; ---- w.c2 ?
|
||||
} ;
|
||||
|
||||
UseVPC x vpc = { ---- big loss of quality (overgeneration) seems inevitable
|
||||
v = <[], [], vpc.v ! defaultAgr> ; ---- agreement
|
||||
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
|
||||
c1 = vpc.c1 ;
|
||||
c2 = vpc.c2 ;
|
||||
adj = \\a => [] ;
|
||||
obj1 = <noObj, defaultAgr> ;
|
||||
obj2 = <noObj,True> ;
|
||||
adv,adV = [] ;
|
||||
ext = [] ;
|
||||
} ;
|
||||
|
||||
StartClC c x a b = {
|
||||
s = declCl (lin Cl a) ++ c.s ++ declCl (lin Cl b) ;
|
||||
c3 = b.c3 ; ----
|
||||
} ;
|
||||
|
||||
UseClC x cl = {
|
||||
subj = [] ;
|
||||
v = <[],[],cl.s> ; ----
|
||||
inf = <[],[]> ;
|
||||
adj = [] ;
|
||||
obj1 = [] ;
|
||||
obj2 = [] ;
|
||||
adV = [] ;
|
||||
adv = [] ;
|
||||
ext = [] ;
|
||||
c3 = cl.c3 ;
|
||||
} ;
|
||||
|
||||
ComplAdv x p np = {s = p.c1 ++ np.s ! objCase ; isAdV = p.isAdV ; c1 = []} ;
|
||||
|
||||
|
||||
---- the following may become parameters for a functor
|
||||
oper
|
||||
be_V : V = mkV "vara" "är" "var" "varit" "varen" "varna" ;
|
||||
|
||||
neg : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "inte"} ;
|
||||
|
||||
reflPron : Agr -> Str = \a -> case a of {Sg => "sig" ; Pl => "oss"} ;
|
||||
|
||||
infVP : Agr -> VP -> Str = \a,vp ->
|
||||
let
|
||||
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
|
||||
in
|
||||
vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit
|
||||
vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
|
||||
|
||||
tenseV : Str -> STense -> Anteriority -> Voice -> V -> Str * Str * Str = \sta,t,a,o,v -> case <t,a> of { --- sta dummy s field of Ant and Tense
|
||||
<Pres,Simul> => <sta ++ v.v ! TV o VPres, [], []> ;
|
||||
<Past,Simul> => <sta ++ v.v ! TV o VPret, [], []> ;
|
||||
<Fut, Simul> => <shall_V.v ! TV Act VPres, [], sta ++ v.v ! TV o VInf> ;
|
||||
<Cond,Simul> => <shall_V.v ! TV Act VPret, [], sta ++ v.v ! TV o VInf> ;
|
||||
<Pres,Anter> => <have_V.v ! TV Act VPres, [], sta ++ v.v ! TV o VSup> ;
|
||||
<Past,Anter> => <have_V.v ! TV Act VPret, [], sta ++ v.v ! TV o VSup> ;
|
||||
<Fut, Anter> => <shall_V.v ! TV Act VPres, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup> ;
|
||||
<Cond,Anter> => <shall_V.v ! TV Act VPret, have_V.v ! TV Act VInf, sta ++ v.v ! TV o VSup>
|
||||
} ;
|
||||
|
||||
tenseInfV : Str -> Anteriority -> Voice -> V -> Str * Str = \sa,a,o,v ->
|
||||
case a of {
|
||||
Simul => <[], sa ++ v.v ! TV o VInf> ; -- hon vill sova
|
||||
Anter => <have_V.v ! TV Act VInf, sa ++ v.v ! TV o VSup> -- hon vill (ha) sovit
|
||||
} ;
|
||||
|
||||
|
||||
declCl : Clause -> Str = \cl -> cl.subj ++ cl.v.p1 ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
declSubordCl : Clause -> Str = \cl -> cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl ;
|
||||
declInvCl : Clause -> Str = \cl -> cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
|
||||
questCl : QCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ;
|
||||
|
||||
questSubordCl : QCl -> Str = \cl ->
|
||||
let
|
||||
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl
|
||||
in case cl.focType of {
|
||||
NoFoc => "om" ++ cl.foc ++ rest ; -- om hon sover
|
||||
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover
|
||||
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne
|
||||
} ;
|
||||
|
||||
that_Compl : Str = "att" | [] ;
|
||||
|
||||
-- this part is usually the same in all reconfigurations
|
||||
restCl : Clause -> Str = \cl -> cl.v.p3 ++ cl.adj ++ cl.obj1 ++ cl.obj2 ++ cl.adv ++ cl.ext ++ cl.c3 ;
|
||||
|
||||
agentCase : ComplCase = "av" ;
|
||||
|
||||
appComplCase : ComplCase -> NP -> Str = \p,np -> p ++ np.s ! Acc ;
|
||||
|
||||
noComplCase : ComplCase = [] ;
|
||||
|
||||
prepComplCase : {s : Str} -> ComplCase = \p -> p.s ;
|
||||
|
||||
noObj : Agr => Str = \\_ => [] ;
|
||||
|
||||
addObj2VP : VP -> (Agr => Str) -> VP = \vp,obj -> vp ** {
|
||||
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
|
||||
} ;
|
||||
|
||||
addExtVP : VP -> Str -> VP = \vp,ext -> vp ** {
|
||||
ext = ext ;
|
||||
} ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---- the lexicon is just for testing: use standard Swe lexicon and morphology instead
|
||||
lin
|
||||
sleep_V = mkV "sova" "sover" "sov" "sovit" "soven" "sovna" ;
|
||||
walk_V = mkV "gå" "går" "gick" "gått" "gången" "gångna" ;
|
||||
love_V2 = mkV "älska" "älskar" "älskade" "älskat" "älskad" "älskade" ;
|
||||
look_V2 = mkV "titta" "tittar" "tittade" "tittat" "tittad" "tittade" "på" [] ;
|
||||
believe_VS = mkV "tro" "tror" "trodde" "trott" "trodd" "trodda" ;
|
||||
tell_V2S = mkV "berätta" "berättar" "berättade" "berättat" "berättad" "berättade" "för" [] ;
|
||||
prefer_V3 = mkV "föredra" "föredrar" "föredrog" "föredragit" "föredragen" "föredragna" [] "framför" ;
|
||||
want_VV = mkV "vilja" "vill" "ville" "velat" "velad" "velade" ;
|
||||
force_V2V = let tvinga : V = mkV "tvinga" "tvingar" "tvingade" "tvingat" "tvingad" "tvingade" in
|
||||
{v = tvinga.v ; c1 = [] ; c2 = "att" ; isSubjectControl = False} ;
|
||||
promise_V2V = mkV "lova" "lovar" "lovade" "lovat" "lovad" "lovade" [] "att" ;
|
||||
wonder_VQ = mkV "undra" "undrar" "undrade" "undrat" "undrad" "undrade" ;
|
||||
become_VA = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
|
||||
become_VN = mkV "bli" "blir" "blev" "blivit" "bliven" "blivna" ;
|
||||
make_V2A = let gora : V = mkV "göra" "gör" "gjorde" "gjort" "gjord" "gjorda" in
|
||||
{v = table {TV Pass VPres => "görs" ; f => gora.v ! f} ; c1 = [] ; c2 = [] ; isSubjectControl = False} ;
|
||||
promote_V2N = let befordra : V = mkV "befordra" "befordrar" "befordrade" "befordrat" "befordrad" "befordrade"
|
||||
in {v = befordra.v ; c1 = [] ; c2 = "till" ; isSubjectControl = False} ; ---- ? de befordrade dem till chefer för sig/dem
|
||||
ask_V2Q = mkV "fråga" "frågar" "frågade" "frågat" "frågad" "frågade" ;
|
||||
|
||||
old_A = {s = table {Sg => "gammal" ; Pl => "gamla"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
married_A2 = {s = table {Sg => "gift" ; Pl => "gifta"} ; c1 = "med" ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
eager_AV = {s = table {Sg => "ivrig" ; Pl => "ivriga"} ; c1 = [] ; c2 = "att" ; obj1 = \\_ => []} ;
|
||||
easy_A2V = {s = table {Sg => "lätt" ; Pl => "lätta"} ; c1 = "för" ; c2 = "att" ; obj1 = \\_ => []} ;
|
||||
professor_N = {s = table {Sg => "professor" ; Pl => "professorer"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
manager_N2 = {s = table {Sg => "chef" ; Pl => "chefer"} ; c1 = "för" ; c2 = [] ; obj1 = \\_ => []} ;
|
||||
|
||||
she_NP = {s = table {Nom => "hon" ; Acc => "henne"} ; a = Sg} ;
|
||||
we_NP = {s = table {Nom => "vi" ; Acc => "oss"} ; a = Pl} ;
|
||||
|
||||
today_Adv = {s = "idag" ; isAdV = False ; c1 = []} ;
|
||||
always_AdV = {s = "alltid" ; isAdV = True ; c1 = []} ;
|
||||
|
||||
who_IP = {s = "vem" ; a = Sg} ;
|
||||
|
||||
PrepNP p np = {s = p.s ++ np.s ! Acc ; isAdV = False} ;
|
||||
|
||||
with_Prep = {s = [] ; isAdV = False ; c1 = "med"} ;
|
||||
|
||||
and_Conj = {s = "och"} ;
|
||||
|
||||
why_IAdv = {s = "varför"} ;
|
||||
|
||||
oper
|
||||
mkV = overload {
|
||||
mkV : (x,y,z,u,v,w : Str) -> V = \x,y,z,u,v,w ->
|
||||
lin V {
|
||||
v = table {
|
||||
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
|
||||
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
|
||||
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
|
||||
} ;
|
||||
c1 = [] ; c2 = [] ; isSubjectControl = True} ;
|
||||
mkV : (x,y,z,u,v,w : Str) -> Str -> Str -> V = \x,y,z,u,v,w,p,q ->
|
||||
lin V {
|
||||
v = table {
|
||||
TV Act VInf => x ; TV Act VPres => y ; TV Act VPret => z ; TV Act VSup => u ;
|
||||
TV Pass VInf => x + "s" ; TV Pass VPres => init y + "s" ; TV Pass VPret => z + "s" ; TV Pass VSup => u + "s" ;
|
||||
PastPart Sg => v ; PastPart Pl => w ; PresPart => x + "nde"
|
||||
} ;
|
||||
c1 = p ; c2 = q ; isSubjectControl = True} ;
|
||||
} ;
|
||||
|
||||
|
||||
have_V : V = mkV "ha" "har" "hade" "haft" "havd" "havda" ;
|
||||
|
||||
shall_V : V = mkV "skola" "ska" "skulle" "skolat" "skolad" "skolade" ;
|
||||
|
||||
}
|
||||
38
lib/src/experimental/alternatives/Trans.gf
Normal file
38
lib/src/experimental/alternatives/Trans.gf
Normal file
@@ -0,0 +1,38 @@
|
||||
--# -path=.:../translator
|
||||
|
||||
abstract Trans =
|
||||
RGLBase - [Pol,Tense]
|
||||
,Pred
|
||||
,Dictionary - [Pol,Tense]
|
||||
|
||||
** {
|
||||
flags
|
||||
startcat=Phr;
|
||||
heuristic_search_factor=0.60;
|
||||
meta_prob=1.0e-5;
|
||||
meta_token_prob=1.1965149246222233e-9;
|
||||
|
||||
fun
|
||||
LiftV : V -> PrV aNone ;
|
||||
LiftV2 : V2 -> PrV (aNP aNone) ;
|
||||
LiftVS : VS -> PrV aS ;
|
||||
LiftVQ : VQ -> PrV aQ ;
|
||||
LiftVV : VV -> PrV aV ;
|
||||
LiftVA : VA -> PrV aA ;
|
||||
LiftVN : VA -> PrV aN ; ----
|
||||
|
||||
LiftV3 : V3 -> PrV (aNP (aNP aNone)) ;
|
||||
LiftV2S : V2S -> PrV (aNP aS) ;
|
||||
LiftV2Q : V2Q -> PrV (aNP aQ) ;
|
||||
LiftV2V : V2V -> PrV (aNP aV) ;
|
||||
LiftV2A : V2A -> PrV (aNP aA) ;
|
||||
LiftV2N : V2A -> PrV (aNP aN) ; ----
|
||||
|
||||
LiftAP : AP -> PrAP aNone ;
|
||||
LiftCN : CN -> PrCN aNone ;
|
||||
|
||||
LiftAdv : Adv -> PrAdv aNone ;
|
||||
LiftAdV : Adv -> PrAdv aNone ;
|
||||
LiftPrep : Prep -> PrAdv (aNP aNone) ;
|
||||
|
||||
}
|
||||
41
lib/src/experimental/alternatives/TransEng.gf
Normal file
41
lib/src/experimental/alternatives/TransEng.gf
Normal file
@@ -0,0 +1,41 @@
|
||||
--# -path=.:../translator
|
||||
|
||||
concrete TransEng of Trans =
|
||||
RGLBaseEng - [Pol,Tense]
|
||||
,PredEng
|
||||
,DictionaryEng - [Pol,Tense]
|
||||
|
||||
** open ResEng, PredInstanceEng, Prelude, (Pr = PredEng) in {
|
||||
|
||||
flags
|
||||
literal=Symb ;
|
||||
|
||||
oper
|
||||
liftV : ResEng.Verb -> Pr.PrV = \v -> lin PrV {s = v.s ; p = v.p ; c1,c2 = [] ; isSubjectControl = False ; vtype = VTAct ; vvtype = VVInf} ;
|
||||
|
||||
lin
|
||||
LiftV v = liftV v ;
|
||||
LiftV2 v = liftV v ** {c1 = v.c2} ;
|
||||
LiftVS v = liftV v ;
|
||||
LiftVQ v = liftV v ;
|
||||
LiftVA v = liftV v ; ---- c1?
|
||||
LiftVN v = liftV v ; ---- c1?
|
||||
LiftVV v = {s = \\f => v.s ! VVF f ; p = v.p ; c1,c2 = [] ; isSubjectControl = False ; vtype = VTAct ; vvtype = VVInf} ; ---- c1? ---- VVF
|
||||
|
||||
LiftV3 v = liftV v ** {c1 = v.c2 ; c2 = v.c3} ;
|
||||
LiftV2S v = liftV v ** {c1 = v.c2} ;
|
||||
LiftV2Q v = liftV v ** {c1 = v.c2} ;
|
||||
LiftV2V v = liftV v ** {c1 = v.c2 ; c2 = v.c3 ; isSubjectControl = False ; vvtype = v.typ} ; ---- subj control should be defined in V2V
|
||||
LiftV2A v = liftV v ** {c1 = v.c2} ;
|
||||
LiftV2N v = liftV v ** {c1 = v.c2} ;
|
||||
|
||||
|
||||
LiftAP ap = ap ** {c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre
|
||||
LiftCN cn = {s = \\n => cn.s ! n ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ;
|
||||
|
||||
LiftAdv a = a ** {isAdV = False ; c1 = []} ;
|
||||
LiftAdV a = a ** {isAdV = True ; c1 = []} ;
|
||||
LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
|
||||
|
||||
|
||||
}
|
||||
41
lib/src/experimental/alternatives/TransSwe.gf
Normal file
41
lib/src/experimental/alternatives/TransSwe.gf
Normal file
@@ -0,0 +1,41 @@
|
||||
--# -path=.:../translator
|
||||
|
||||
concrete TransSwe of Trans =
|
||||
RGLBaseSwe - [Pol,Tense]
|
||||
,PredSwe
|
||||
,DictionarySwe - [Pol,Tense]
|
||||
|
||||
** open CommonScand, ResSwe, PredInstanceSwe, Prelude in {
|
||||
|
||||
flags
|
||||
literal=Symb ;
|
||||
|
||||
oper
|
||||
liftV = PredInstanceSwe.liftV ;
|
||||
|
||||
lin
|
||||
LiftV v = liftV v ;
|
||||
LiftV2 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftVS v = liftV v ;
|
||||
LiftVQ v = liftV v ;
|
||||
LiftVA v = liftV v ; ---- c1?
|
||||
LiftVN v = liftV v ; ---- c1?
|
||||
LiftVV v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
|
||||
LiftV3 v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
|
||||
|
||||
LiftV2S v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV2Q v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV2V v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s ; c2 = v.c3.s} ;
|
||||
LiftV2A v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
LiftV2N v = <liftV <v : Verb> : PrVerb> ** {c1 = v.c2.s} ;
|
||||
|
||||
LiftAP ap = {s = \\a => ap.s ! agr2aformpos a ; c1,c2 = [] ; obj1 = \\_ => []} ; --- isPre
|
||||
LiftCN cn = {s = \\n => cn.s ! n ! DIndef ! Nom ; c1,c2 = [] ; obj1 = \\_ => []} ;
|
||||
|
||||
LiftAdv a = a ** {isAdV = False ; c1 = []} ;
|
||||
LiftAdV a = a ** {isAdV = True ; c1 = []} ;
|
||||
LiftPrep p = {s = [] ; isAdV = False ; c1 = p.s} ;
|
||||
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user