msyds/gf-rgl
1
0
Fork 0
forked from GitHub/gf-rgl
Code Pull Requests Activity

started embedding Predication in the big translation grammar

Browse Source
This commit is contained in:
aarne
2014-02-04 16:12:22 +00:00
parent 3f862b14c7
commit 86f101dc43
6 changed files with 838 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

100
src/experimental/Pred.gf Normal file
View File

@@ -0,0 +1,100 @@
abstract Pred = Cat [Ant,Tense,Pol,NP,Utt,IP,IAdv,Conj,Prep] ** {
cat
Arg ;
PrV Arg ;
PrVP Arg ;
VPC Arg ; -- conjunction of VP
-- Ant ;
-- Tense ;
-- Pol ;
PrCl Arg ;
ClC Arg ; -- conjunction of Cl
PrQCl Arg ;
-- NP ;
PrAdv ;
PrS ;
-- Utt ;
PrAP Arg ;
PrCN Arg ; -- the country he became the president of
-- IP ;
-- Prep ;
-- 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) -> PrV a -> PrVP a ;
PassUseV : Ant -> Tense -> Pol -> (a : Arg) -> PrV (aNP a) -> PrVP a ;
AgentPassUseV : Ant -> Tense -> Pol -> (a : Arg) -> PrV (aNP a) -> NP -> PrVP a ;
SlashV2 : (a : Arg) -> PrVP (aNP a) -> NP -> PrVP a ; -- consuming first NP
SlashV3 : (a : Arg) -> PrVP (aNP (aNP a)) -> NP -> PrVP (aNP a) ; -- consuming second NP
ComplVS : (a : Arg) -> PrVP aS -> PrCl a -> PrVP a ;
ComplVV : (a : Arg) -> PrVP aV -> PrVP a -> PrVP a ;
ComplVQ : (a : Arg) -> PrVP aQ -> PrQCl a -> PrVP a ;
ComplVA : (a : Arg) -> PrVP aA -> PrAP a -> PrVP a ;
ComplVN : (a : Arg) -> PrVP aN -> PrCN a -> PrVP a ;
SlashV2S : (a : Arg) -> PrVP (aNP aS) -> PrCl a -> PrVP (aNP a) ; -- a:Arg gives slash propagation, SlashVS
SlashV2V : (a : Arg) -> PrVP (aNP aV) -> PrVP a -> PrVP (aNP a) ;
SlashV2A : (a : Arg) -> PrVP (aNP aA) -> PrAP a -> PrVP (aNP a) ;
SlashV2N : (a : Arg) -> PrVP (aNP aN) -> PrCN a -> PrVP (aNP a) ;
SlashV2Q : (a : Arg) -> PrVP (aNP aA) -> PrQCl a -> PrVP (aNP a) ;
UseAP : Ant -> Tense -> Pol -> (a : Arg) -> PrAP a -> PrVP a ;
PredVP : (a : Arg) -> NP -> PrVP a -> PrCl a ;
PrepCl : Prep -> (a : Arg) -> PrCl a -> PrCl (aNP a) ; -- slash creation (S/NP): hon tittar på (oss)
SlashClNP : (a : Arg) -> PrCl (aNP a) -> NP -> PrCl a ; -- slash consumption: hon tittar på + oss
ReflVP : (a : Arg) -> PrVP (aNP a) -> PrVP a ; -- refl on first position (direct object)
ReflVP2 : (a : Arg) -> PrVP (aNP (aNP a)) -> PrVP (aNP a) ; -- refl on second position (indirect object)
QuestVP : (a : Arg) -> IP -> PrVP a -> PrQCl a ;
QuestSlash : (a : Arg) -> IP -> PrQCl (aNP a) -> PrQCl a ;
QuestCl : (a : Arg) -> PrCl a -> PrQCl a ;
QuestIAdv : (a : Arg) -> IAdv -> PrCl a -> PrQCl a ;
UseCl : PrCl aNone -> PrS ;
UseQCl : PrQCl aNone -> PrS ; -- deprecate QS
UseAdvCl : PrAdv -> PrCl aNone -> PrS ; -- lift adv to front
UttS : PrS -> Utt ;
-- when to add adverbs
---- AdvVP : Adv -> (a : Arg) -> PrVP a -> PrVP 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 : Adv -> (a : Arg) -> PrCl a -> PrCl a ;
AdvQCl : Adv -> (a : Arg) -> PrQCl a -> PrQCl a ;
-- participles as adjectives
PresPartAP : (a : Arg) -> PrV a -> PrAP a ;
PastPartAP : (a : Arg) -> PrV (aNP a) -> PrAP a ;
AgentPastPartAP : (a : Arg) -> PrV (aNP a) -> NP -> PrAP a ;
-- PrVP coordination
StartVPC : Conj -> (a : Arg) -> PrVP a -> PrVP a -> VPC a ;
ContVPC : (a : Arg) -> PrVP a -> VPC a -> VPC a ;
UseVPC : (a : Arg) -> VPC a -> PrVP a ;
-- clause coordination, including "she loves and we look at (her)"
StartClC : Conj -> (a : Arg) -> PrCl a -> PrCl a -> ClC a ;
ContClC : (a : Arg) -> PrCl a -> ClC a -> ClC a ;
UseClC : (a : Arg) -> ClC a -> PrCl a ;
}

639
src/experimental/PredEng.gf Normal file
View File

@@ -0,0 +1,639 @@
concrete PredEng of Pred = open Prelude, ResEng 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?
{-
param
Number = Sg | Pl ;
Person = P1 | P2 | P3 ;
Agr = Ag Number Person ;
VAgr = VASgP1 | VASgP3 | VAPl ;
Case = Nom | Acc ;
STense = Pres | Past | Fut | Cond ;
Anteriority = Simul | Anter ;
Polarity = Pos | Neg ;
VForm = VInf | VPres | VPast | VPastPart | VPresPart ;
Voice = Act | Pass ;
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
Unit = UUnit ;
oper
NAgr = Number ;
AAgr = Unit ;
IPAgr = Number ;
defaultAgr : Agr = Ag Sg P3 ;
ComplCase = Str ; -- preposition
-- omitting rich Agr information
agr2vagr : Agr -> VAgr = \a -> case a of {
Ag Sg P1 => VASgP1 ;
Ag Sg P3 => VASgP3 ;
_ => VAPl
} ;
agr2aagr : Agr -> AAgr = \n -> UUnit ;
agr2nagr : Agr -> NAgr = \a -> case a of {
Ag n _ => n
} ;
-- restoring full Agr
ipagr2agr : IPAgr -> Agr = \n -> Ag n P3 ;
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 => Ag Sg P1 ;
VASgP3 => Ag Sg P3 ;
VAPl => Ag Pl P3
} ;
lincat
Arg = {s : Str} ;
V = {
v : VForm => Str ;
c1 : ComplCase ;
c2 : ComplCase ;
isSubjectControl : Bool ;
isAux : Bool ;
} ;
oper
VerbPhrase = {
v : VAgr => 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 ;
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, e.g. *vem* älskar hon
focType : FocusType ; --- if already filled, then use other place: vem älskar *vem*
} ;
VPC = {
v : VAgr => 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} ;
S = {s : Str} ;
Utt = {s : Str} ;
AP = {
s : AAgr => Str ;
c1, c2 : ComplCase ;
obj1 : Agr => Str
} ;
CN = {
s : NAgr => Str ;
c1, c2 : ComplCase ;
obj1 : Agr => Str
} ;
IP = {s : Str ; a : IPAgr} ;
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 = Cond} ;
ASimul = {s = [] ; a = Simul} ;
AAnter = {s = [] ; a = Anter} ;
PPos = {s = [] ; p = Pos} ;
PNeg = {s = [] ; p = Neg} ;
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 ;
adj = noObj ;
obj1 = <noObj, defaultAgr> ; ---- not used, just default value
obj2 = <noObj, v.isSubjectControl> ;
adV = negAdV p ;
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 ;
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 ;
adj = \\a => [] ;
obj1 = <noObj, defaultAgr> ;
obj2 = <noObj, True> ;
adV = negAdV p ;
adv = appComplCase agentCase np ; ---- add a specific field for agent?
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 ;
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 ! 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 ! 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> ; --- 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 ** {
v = vp.v ! agr2vagr np.a ;
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
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: ä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 = let ipa = ipagr2agr ip.a in
vp ** {
v = vp.v ! ipagr2vagr ip.a ;
foc = ip.s ; -- vem älskar henne
focType = FocSubj ;
subj = [] ;
adj = vp.adj ! ipa ;
obj1 = 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.a ;
} ;
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 cl ** {
foc = focobj.p1 ;
focType = focobj.p3 ;
subj = cl.subj ;
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 a x cl = cl ** case a.isAdV of {True => {adV = cl.adV ++ a.s ; adv = cl.adv} ; False => {adv = cl.adv ++ a.s ; adV = cl.adV}} ;
AdvQCl a x cl = cl ** {adv = cl.adv ++ a.s} ;
PresPartAP x v = {
s = \\a => v.v ! vPresPart a ;
c1 = v.c1 ; -- tittande på henne
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.s ++
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.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 = \\a => <[], [], vpc.v ! a> ;
inf = <[], vpc.inf ! defaultAgr> ; ---- agreement
c1 = vpc.c1 ;
c2 = vpc.c2 ;
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.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 ;
qforms = <[],[]> ; ---- qforms
} ;
---- the following may become parameters for a functor
oper
vPastPart : AAgr -> VForm = \_ -> VPastPart ;
vPresPart : AAgr -> VForm = \_ -> VPresPart ;
be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ;
negAdV : Pol -> Str = \p -> p.s ;
reflPron : Agr -> Str = \a -> case a of {
Ag Sg P1 => "myself" ;
Ag Sg P2 => "yourself" ;
Ag Sg P3 => "herself" | "himself" | "itself" ; ----
Ag Pl P1 => "ourselves" ;
Ag Pl P2 => "ourselves" ;
Ag Pl P3 => "yourselves"
} ;
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.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 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 ! VPastPart> ;
<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 ! VPastPart>
} ;
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 ! VPastPart>
| <have_AuxC vt Pos, not_Str p, sta ++ v.v ! VPastPart> ;
<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 ! VPastPart>
| <will_AuxC vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPastPart>
} ;
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 ! VPastPart
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 ! VPastPart
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> ; -- hon vill sova
Anter => <have_Aux VInf Pos, sa ++ v.v ! VPastPart> -- hon vill (ha) sovit
} ;
----- 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 ;
agentCase : ComplCase = "by" ;
appComplCase : ComplCase -> NP -> Str = \p,np -> p ++ np.s ! Acc ;
noComplCase : ComplCase = [] ;
prepComplCase : Prep -> ComplCase = \p -> p.s ;
noObj : Agr => Str = \\_ => [] ;
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 ;
} ;
-}
oper
---- 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"} ;
}

20
src/experimental/RGLBase.gf Normal file
View File

@@ -0,0 +1,20 @@
abstract RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
Noun - [PPartNP], -- to be generalized
Adjective,
Numeral,
Conjunction,
Adverb,
Phrase - [UttS],
---- Sentence,
---- Question,
Relative,
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
Symbol [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

20
src/experimental/RGLBaseEng.gf Normal file
View File

@@ -0,0 +1,20 @@
concrete RGLBaseEng of RGLBase =
-- modules in Grammar, excluding Structural, Verb, Sentence, Question
---- Tense,
NounEng - [PPartNP], -- to be generalized
AdjectiveEng,
NumeralEng,
ConjunctionEng,
AdverbEng,
PhraseEng - [UttS],
---- Sentence,
---- Question,
RelativeEng,
---- Idiom [NP, VP, Cl, Tense, ProgrVP, ExistNP, SelfAdvVP, SelfAdVVP, SelfNP], ---- why only these?
SymbolEng [PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP] ; ---- why only these?
---- Construction,
---- Extensions,
---- Documentation ;

32
src/experimental/Trans.gf Normal file
View File

@@ -0,0 +1,32 @@
--# -path=.:../translator
abstract Trans =
RGLBase
,Pred
,Dictionary
** {
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) ; ----
}

27
src/experimental/TransEng.gf Normal file
View File

@@ -0,0 +1,27 @@
--# -path=.:../translator
concrete TransEng of Trans =
RGLBaseEng
,PredEng
,DictionaryEng
** {
{-
lin
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) ; ----
-}
}