GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-24 10:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

PredicationEng complete with all agreement forms and questions; questions with contracted auxiliaries still to do

Browse Source
This commit is contained in:
aarne
2014-02-04 15:24:06 +00:00
parent abfd4b9c96
commit 3953ac3371
1 changed files with 229 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

308
lib/src/experimental/PredicationEng.gf
View File

@@ -7,7 +7,10 @@ concrete PredicationEng of Predication = open Prelude in {
-- a question: would it make sense to make this into a functor? -- a question: would it make sense to make this into a functor?
param param
Agr = Sg | Pl ; Number = Sg | Pl ;
Person = P1 | P2 | P3 ;
Agr = Ag Number Person ;
VAgr = VASgP1 | VASgP3 | VAPl ;
Case = Nom | Acc ; Case = Nom | Acc ;
STense = Pres | Past | Fut | Cond ; STense = Pres | Past | Fut | Cond ;
Anteriority = Simul | Anter ; Anteriority = Simul | Anter ;
@@ -17,11 +20,44 @@ param
FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover FocusType = NoFoc | FocSubj | FocObj ; -- sover hon/om hon sover, vem älskar hon/vem hon älskar, vem sover/vem som sover
Unit = UUnit ;
oper oper
defaultAgr = Sg ; NAgr = Number ;
AAgr = Unit ;
IPAgr = Number ;
defaultAgr : Agr = Ag Sg P3 ;
ComplCase = Str ; -- preposition 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 lincat
Arg = {s : Str} ; Arg = {s : Str} ;
@@ -33,8 +69,9 @@ lincat
isAux : Bool ; isAux : Bool ;
} ; } ;
VP = { oper
v : Agr => Str * Str * Str ; -- ska,ha,sovit VerbPhrase = {
v : VAgr => Str * Str * Str ; -- ska,ha,sovit
inf : Str * Str ; -- ha,sovit inf : Str * Str ; -- ha,sovit
c1 : ComplCase ; c1 : ComplCase ;
c2 : ComplCase ; c2 : ComplCase ;
@@ -43,10 +80,11 @@ lincat
obj2 : (Agr => Str) * Bool ; -- subject control = True obj2 : (Agr => Str) * Bool ; -- subject control = True
adv : Str ; adv : Str ;
adV : Str ; adV : Str ;
ext : Str ext : Str ;
qforms : VAgr => Str * Str -- special Eng for introducing "do" in questions
} ; } ;
oper Clause = { Clause = {
v : Str * Str * Str ; v : Str * Str * Str ;
inf : Str * Str ; inf : Str * Str ;
adj,obj1,obj2 : Str ; adj,obj1,obj2 : Str ;
@@ -54,10 +92,12 @@ oper Clause = {
adV : Str ; adV : Str ;
ext : Str ; ext : Str ;
subj : Str ; subj : Str ;
c3 : ComplCase -- for a slashed adjunct, not belonging to the verb valency c3 : ComplCase ; -- for a slashed adjunct, not belonging to the verb valency
qforms : Str * Str
} ; } ;
lincat lincat
VP = VerbPhrase ;
Cl = Clause ; Cl = Clause ;
QCl = Clause ** { QCl = Clause ** {
@@ -66,7 +106,7 @@ lincat
} ; } ;
VPC = { VPC = {
v : Agr => Str ; v : VAgr => Str ;
inf : Agr => Str ; inf : Agr => Str ;
c1 : ComplCase ; c1 : ComplCase ;
c2 : ComplCase c2 : ComplCase
@@ -86,18 +126,16 @@ lincat
S = {s : Str} ; S = {s : Str} ;
Utt = {s : Str} ; Utt = {s : Str} ;
AP = { AP = {
s : Agr => Str ; s : AAgr => Str ;
c1, c2 : ComplCase ; c1, c2 : ComplCase ;
obj1 : obj1 : Agr => Str
Agr => Str
} ; } ;
CN = { CN = {
s : Agr => Str ; s : NAgr => Str ;
c1, c2 : ComplCase ; c1, c2 : ComplCase ;
obj1 : obj1 : Agr => Str
Agr => Str
} ; } ;
IP = {s : Str ; a : Agr} ; IP = {s : Str ; a : IPAgr} ;
Prep = {s : Str} ; Prep = {s : Str} ;
Conj = {s : Str} ; Conj = {s : Str} ;
IAdv = {s : Str} ; IAdv = {s : Str} ;
@@ -127,6 +165,7 @@ lin
adV = negAdV p ; adV = negAdV p ;
adv = [] ; adv = [] ;
ext = [] ; ext = [] ;
qforms = \\agr => qformsV (a.s ++ t.s ++ p.s) t.t a.a p.p agr v ;
} ; } ;
PassUseV a t p _ v = { PassUseV a t p _ v = {
@@ -140,6 +179,7 @@ lin
adV = negAdV p ; adV = negAdV p ;
adv = [] ; adv = [] ;
ext = [] ; ext = [] ;
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ; } ;
AgentPassUseV a t p _ v np = { AgentPassUseV a t p _ v np = {
@@ -153,6 +193,7 @@ lin
adV = negAdV p ; adV = negAdV p ;
adv = appComplCase agentCase np ; ---- add a specific field for agent? adv = appComplCase agentCase np ; ---- add a specific field for agent?
ext = [] ; ext = [] ;
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ; } ;
UseAP a t p _ ap = { UseAP a t p _ ap = {
@@ -160,12 +201,13 @@ lin
inf = tenseInfV a.s a.a p.p Act be_V ; inf = tenseInfV a.s a.a p.p Act be_V ;
c1 = ap.c1 ; c1 = ap.c1 ;
c2 = ap.c2 ; c2 = ap.c2 ;
adj = \\a => ap.s ! a ; adj = \\a => ap.s ! agr2aagr a ;
obj1 = <ap.obj1, defaultAgr> ; obj1 = <ap.obj1, defaultAgr> ;
obj2 = <noObj, True> ; --- there are no A3's obj2 = <noObj, True> ; --- there are no A3's
adV = negAdV p ; adV = negAdV p ;
adv = [] ; adv = [] ;
ext = [] ; ext = [] ;
qforms = \\agr => qformsBe (a.s ++ t.s ++ p.s) t.t a.a p.p agr ;
} ; } ;
SlashV2 x vp np = vp ** { SlashV2 x vp np = vp ** {
@@ -180,9 +222,9 @@ lin
ComplVV x vp vpo = addObj2VP vp (\\a => infVP a vpo) ; ---- infForm 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 ComplVA x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
ComplVN x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cnForm 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 SlashV2S x vp cl = addExtVP vp (that_Compl ++ declSubordCl (lin Cl cl)) ; ---- sentence form
@@ -190,9 +232,9 @@ lin
SlashV2V x vp vpo = addObj2VP vp (\\a => infVP a (lin VP vpo)) ; ---- infForm 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 SlashV2A x vp ap = addObj2VP vp (\\a => ap.s ! agr2aagr a ++ ap.obj1 ! a) ; ---- adjForm
SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! a ++ cn.obj1 ! a) ; ---- cn form SlashV2N x vp cn = addObj2VP vp (\\a => cn.s ! agr2nagr a ++ cn.obj1 ! a) ; ---- cn form
ReflVP x vp = vp ** { ReflVP x vp = vp ** {
obj1 : (Agr => Str) * Agr = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead obj1 : (Agr => Str) * Agr = <\\a => reflPron a, defaultAgr> ; --- hack: defaultAgr will not be used but subj.a instead
@@ -203,12 +245,13 @@ lin
} ; } ;
PredVP x np vp = vp ** { PredVP x np vp = vp ** {
v = vp.v ! np.a ; v = vp.v ! agr2vagr np.a ;
subj = np.s ! Nom ; subj = np.s ! Nom ;
adj = vp.adj ! np.a ; adj = vp.adj ! np.a ;
obj1 = vp.c1 ++ vp.obj1.p1 ! np.a ; ---- apply complCase 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 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 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 PrepCl p x cl = cl ** { -- Cl/NP ::= Cl PP/NP
@@ -226,15 +269,17 @@ lin
QuestIAdv x iadv cl = cl ** {foc = iadv.s ; focType = FocObj} ; -- FocObj implies Foc + V + Subj: varför ä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 ** { QuestVP x ip vp = let ipa = ipagr2agr ip.a in
v = vp.v ! ip.a ; vp ** {
v = vp.v ! ipagr2vagr ip.a ;
foc = ip.s ; -- vem älskar henne foc = ip.s ; -- vem älskar henne
focType = FocSubj ; focType = FocSubj ;
subj = [] ; subj = [] ;
adj = vp.adj ! ip.a ; adj = vp.adj ! ipa ;
obj1 = vp.c1 ++ vp.obj1.p1 ! ip.a ; ---- appComplCase obj1 = vp.c1 ++ vp.obj1.p1 ! ipa ; ---- appComplCase
obj2 = vp.c2 ++ vp.obj2.p1 ! (case vp.obj2.p2 of {True => ip.a ; False => vp.obj1.p2}) ; ---- 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? c3 = noComplCase ; -- for one more prep to build ClSlash ---- ever needed for QCl?
qforms = vp.qforms ! ipagr2vagr ip.a ;
} ; } ;
QuestSlash x ip cl = QuestSlash x ip cl =
@@ -287,13 +332,16 @@ lin
StartVPC c x v w = { ---- some loss of quality seems inevitable StartVPC c x v w = { ---- some loss of quality seems inevitable
v = \\a => v = \\a =>
let vv = v.v ! a ; wv = w.v ! a let
vv = v.v ! a ;
wv = w.v ! a ;
vpa = vagr2agr a ;
in in
vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! a ++ vv.p1 ++ v.adV ++ vv.p2 ++ vv.p3 ++ v.adj ! vpa ++
v.c1 ++ v.obj1.p1 ! a ++ v.c2 ++ v.obj2.p1 ! a ++ v.adv ++ v.ext ---- appComplCase v.c1 ++ v.obj1.p1 ! vpa ++ v.c2 ++ v.obj2.p1 ! vpa ++ v.adv ++ v.ext ---- appComplCase
++ c.s ++ ++ c.s ++
wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! a ++ ---- appComplCase wv.p1 ++ w.adV ++ wv.p2 ++ wv.p3 ++ w.adj ! vpa ++ ---- appComplCase
w.c1 ++ w.obj1.p1 ! a ++ w.c2 ++ w.obj2.p1 ! a ++ w.adv ++ w.ext ; w.c1 ++ w.obj1.p1 ! vpa ++ w.c2 ++ w.obj2.p1 ! vpa ++ w.adv ++ w.ext ;
inf = \\a => inf = \\a =>
infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ; infVP a (lin VP v) ++ c.s ++ infVP a (lin VP w) ;
c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w... c1 = [] ; ---- w.c1 ? --- the full story is to unify v and w...
@@ -310,6 +358,7 @@ lin
obj2 = <noObj,True> ; obj2 = <noObj,True> ;
adv,adV = [] ; adv,adV = [] ;
ext = [] ; ext = [] ;
qforms = \\a => <"do", vpc.inf ! defaultAgr> ; ---- do/does/did
} ; } ;
StartClC c x a b = { StartClC c x a b = {
@@ -328,43 +377,75 @@ lin
adv = [] ; adv = [] ;
ext = [] ; ext = [] ;
c3 = cl.c3 ; c3 = cl.c3 ;
qforms = <[],[]> ; ---- qforms
} ; } ;
---- the following may become parameters for a functor ---- the following may become parameters for a functor
oper oper
vPastPart : Agr -> VForm = \_ -> VPastPart ; vPastPart : AAgr -> VForm = \_ -> VPastPart ;
vPresPart : Agr -> VForm = \_ -> VPresPart ; vPresPart : AAgr -> VForm = \_ -> VPresPart ;
be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ; be_V : V = lin V {v = mkVerb "be" "is" "was" "been" "being" ; c1,c2 = [] ; isAux = True ; isSubjectControl = False} ;
negAdV : Pol -> Str = \p -> p.s ; negAdV : Pol -> Str = \p -> p.s ;
reflPron : Agr -> Str = \a -> case a of {Sg => "herself" ; Pl => "us"} ; 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 -> infVP : Agr -> VP -> Str = \a,vp ->
let let
a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2} a2 = case vp.obj2.p2 of {True => a ; False => vp.obj1.p2}
in in
vp.adV ++ (vp.inf.p1 | []) ++ vp.inf.p2 ++ ---- *hon tvingar oss att sovit 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 ; vp.adj ! a ++ vp.c1 ++ vp.obj1.p1 ! a ++ vp.c2 ++ vp.obj2.p1 ! a2 ++ vp.adv ++ vp.ext ;
tenseV : Str -> STense -> Anteriority -> Polarity -> Voice -> Agr -> V -> Str * Str * Str = qformsV : Str -> STense -> Anteriority -> Polarity -> VAgr -> V -> Str * Str =
\sta,t,a,p,o,agr,v -> case o of { \sta,t,a,p,agr,v ->
Act => tenseActV sta t a p agr v ; let
Pass => tensePassV sta t a p agr v 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>
} ; } ;
tenseActV : Str -> STense -> Anteriority -> Polarity -> Agr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> qformsBe : Str -> STense -> Anteriority -> Polarity -> VAgr -> Str * Str =
let vt = case <t,agr> of { \sta,t,a,p,agr ->
<Pres,Sg> => VPres ; 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 ; <Past|Cond,_ > => VPast ;
_ => VInf _ => VInf
} } ;
in in
case <t,a> of { case <t,a> of {
<Pres|Past, Simul> => <Pres|Past, Simul> =>
@@ -372,21 +453,49 @@ oper
True => <sta ++ v.v ! vt, [], []> ; True => <sta ++ v.v ! vt, [], []> ;
False => case p of { False => case p of {
Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case Pos => <[], sta ++ v.v ! vt, []> ; -- this is the deviating case
Neg => <do_Aux vt p, [], sta ++ v.v ! VInf> Neg => <do_Aux vt Pos, not_Str p, sta ++ v.v ! VInf>
| <do_Aux vt Pos, not_Str p, sta ++ v.v ! VInf>
} }
} ; } ;
<Pres|Past, Anter> => <have_Aux vt p, [], sta ++ v.v ! VPastPart>
| <have_Aux vt Pos, not_Str p, sta ++ v.v ! VPastPart> ; <Pres|Past, Anter> => <have_Aux vt Pos, not_Str p, sta ++ v.v ! VPastPart> ;
<Fut|Cond, Simul> => <will_Aux vt p, [], sta ++ v.v ! VInf> <Fut|Cond, Simul> => <will_Aux vt Pos, not_Str p, sta ++ v.v ! VInf> ;
| <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>
<Fut|Cond, Anter> => <will_Aux vt p, have_Aux VInf Pos, sta ++ v.v ! VPastPart>
| <will_Aux vt Pos, not_Str p ++ have_Aux VInf Pos, sta ++ v.v ! VPastPart>
} ; } ;
tensePassV : Str -> STense -> Anteriority -> Polarity -> Agr -> V -> Str * Str * Str = \sta,t,a,p,agr,v -> 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 let
be = be_Aux sta t a p agr ; 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 done = v.v ! VPastPart
in in
<be.p1, be.p2, be.p3 ++ done> ; <be.p1, be.p2, be.p3 ++ done> ;
@@ -397,26 +506,41 @@ oper
Anter => <have_Aux VInf Pos, sa ++ v.v ! VPastPart> -- hon vill (ha) sovit Anter => <have_Aux VInf Pos, sa ++ v.v ! VPastPart> -- hon vill (ha) sovit
} ; } ;
be_Aux : Str -> STense -> Anteriority -> Polarity -> Agr -> Str * Str * Str = \sta,t,a,p,agr -> ----- 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 let
beV = tenseActV sta t a p agr be_V beV = tenseActV sta t a p agr be_V
in in
case <t,a,p,agr> of { case <t,a,p,agr> of {
<Pres,Simul,Pos,Sg> => <"is" ++ sta, [], []> <Pres,Simul,Pos,VASgP3> => <"is" ++ sta, [], []> ;
| <Predef.BIND ++ "'s" ++ sta, [], []> ; <Pres,Simul,Pos,VASgP1> => <"am" ++ sta, [], []> ;
<Pres,Simul,Pos,Pl> => <"are" ++ sta, [], []> <Pres,Simul,Pos,VAPl> => <"are" ++ sta, [], []> ;
| <Predef.BIND ++ "'re" ++ sta, [], []> ; <Pres,Simul,Neg,VASgP3> => <"is" ++ sta, "not", []> ;
<Pres,Simul,Neg,Sg> => <"is" ++ sta, "not", []> <Pres,Simul,Neg,VASgP1> => <"am" ++ sta, "not", []> ;
| <Predef.BIND ++ "'s" ++ 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, [], []> ; | <"isn't" ++ sta, [], []> ;
<Pres,Simul,Neg,Pl> => <"are" ++ sta, "not", []> <Pres,Simul,Neg,VASgP1> => <Predef.BIND ++ "'m" ++ sta, "not", []> ;
| <Predef.BIND ++ "'re" ++ sta, "not", []> <Pres,Simul,Neg,VAPl> => <Predef.BIND ++ "'re" ++ sta, "not", []>
| <"aren't" ++ sta, [], []> ; | <"aren't" ++ sta, [], []> ;
<Past,Simul,Pos,Pl> => <"were" ++ sta, [], []> ; <Past,Simul,Pos,VAPl> => <"were" ++ sta, [], []> ;
<Past,Simul,Neg,Sg> => <"was" ++ sta, "not", []> <Past,Simul,Neg,VAPl> => <"weren't" ++ sta, [], []> ;
| <"wasn't" ++ sta, [], []> ; <Past,Simul,Neg,_> => <"wasn't" ++ sta, [], []> ;
<Past,Simul,Neg,Pl> => <"were" ++ sta, "not", []>
| <"weren't" ++ sta, [], []> ;
_ => beV _ => beV
} ; } ;
@@ -424,15 +548,19 @@ oper
declSubordCl : Clause -> Str = declCl ; declSubordCl : Clause -> Str = declCl ;
declInvCl : Clause -> Str = declCl ; declInvCl : Clause -> Str = declCl ;
questCl : QCl -> Str = \cl -> cl.foc ++ cl.v.p1 ++ cl.subj ++ cl.adV ++ cl.v.p2 ++ restCl cl ; 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 -> questSubordCl : QCl -> Str = \cl ->
let let
rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl rest = cl.subj ++ cl.adV ++ cl.v.p1 ++ (cl.v.p2 | []) ++ restCl cl
in case cl.focType of { in case cl.focType of {
NoFoc => "if" ++ cl.foc ++ rest ; -- om hon sover NoFoc => "if" ++ cl.foc ++ rest ; -- om she sleeps
FocObj => cl.foc ++ rest ; -- vem älskar hon / varför hon sover FocObj => cl.foc ++ rest ; -- who she loves / why she sleeps
FocSubj => cl.foc ++ "som" ++ rest -- vem som älskar henne FocSubj => cl.foc ++ rest -- who loves her
} ; } ;
that_Compl : Str = "that" | [] ; that_Compl : Str = "that" | [] ;
@@ -450,11 +578,11 @@ oper
noObj : Agr => Str = \\_ => [] ; noObj : Agr => Str = \\_ => [] ;
addObj2VP : VP -> (Agr => Str) -> VP = \vp,obj -> vp ** { addObj2VP : VerbPhrase -> (Agr => Str) -> VerbPhrase = \vp,obj -> vp ** {
obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ; obj2 = <\\a => vp.obj2.p1 ! a ++ obj ! a, vp.obj2.p2> ;
} ; } ;
addExtVP : VP -> Str -> VP = \vp,ext -> vp ** { addExtVP : VerbPhrase -> Str -> VerbPhrase = \vp,ext -> vp ** {
ext = ext ; ext = ext ;
} ; } ;
@@ -489,8 +617,8 @@ lin
professor_N = {s = table {Sg => "professor" ; Pl => "professors"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ; professor_N = {s = table {Sg => "professor" ; Pl => "professors"} ; c1 = [] ; c2 = [] ; obj1 = \\_ => []} ;
manager_N2 = {s = table {Sg => "manager" ; Pl => "managers"} ; c1 = "for" ; c2 = [] ; obj1 = \\_ => []} ; manager_N2 = {s = table {Sg => "manager" ; Pl => "managers"} ; c1 = "for" ; c2 = [] ; obj1 = \\_ => []} ;
she_NP = {s = table {Nom => "she" ; Acc => "her"} ; a = Sg} ; she_NP = {s = table {Nom => "she" ; Acc => "her"} ; a = Ag Sg P3} ;
we_NP = {s = table {Nom => "we" ; Acc => "us"} ; a = Pl} ; we_NP = {s = table {Nom => "we" ; Acc => "us"} ; a = Ag Pl P1} ;
today_Adv = {s = "today" ; isAdV = False} ; today_Adv = {s = "today" ; isAdV = False} ;
always_AdV = {s = "always" ; isAdV = True} ; always_AdV = {s = "always" ; isAdV = True} ;
@@ -523,19 +651,34 @@ oper
edV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ed" ; edV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ed" ;
ingV : Str -> Str = \s -> case s of {us + "e" => us ; _ => s} + "ing" ; 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 { will_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf|VPres, Pos> => "will" | Predef.BIND ++ "'ll" ; <VInf|VPres, Pos> => varAux "will" "ll" ;
<VInf|VPres, Neg> => "won't" ; <VInf|VPres, Neg> => "won't" ;
<VPast|_ , Pos> => "would" | Predef.BIND ++ "'d" ; <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" <VPast|_ , Neg> => "wouldn't"
} ; } ;
have_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of { have_Aux : VForm -> Polarity -> Str = \vf,p -> case <vf,p> of {
<VInf, Pos> => "have" | Predef.BIND ++ "'ve" ; --- slightly overgenerating as used in infinitive <VInf, Pos> => varAux "have" "ve" ; --- slightly overgenerating if used in infinitive
<VInf, Neg> => "haven't" ; <VInf, Neg> => "haven't" ;
<VPres, Pos> => "has" | Predef.BIND ++ "'s" ; <VPres, Pos> => varAux "has" "s" ;
<VPres, Neg> => "hasn't" ; <VPres, Neg> => "hasn't" ;
<VPast|_ , Pos> => "had" | Predef.BIND ++ "'d" ; <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" <VPast|_ , Neg> => "hadn't"
} ; } ;
@@ -548,6 +691,9 @@ oper
<VPast|_ , Neg> => "didn't" <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"} ; not_Str : Polarity -> Str = \p -> case p of {Pos => [] ; Neg => "not"} ;
} }