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

experiment in discontinuous Cl type in Romance, tried in French. The current result is that compilation is twice as fast as before, but parsing becomes slower. Hence not in the main RGL yet.

Browse Source
This commit is contained in:
aarne
2014-11-29 11:05:51 +00:00
parent e4bb1d09af
commit 12cd4ea245
9 changed files with 1118 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

137
lib/src/romance/exper/CatRomance.gf Normal file
View File

@@ -0,0 +1,137 @@
incomplete concrete CatRomance of Cat = CommonX - [SC,Pol]
** open Prelude, CommonRomance, ResRomance, (R = ParamX) in {
flags optimize=all_subs ;
coding=utf8 ;
lincat
-- exception to CommonX, due to the distinction ne/ne-pas
Pol = {s : Str ; p : RPolarity} ;
-- Tensed/Untensed
S = {s : Mood => Str} ;
QS = {s : QForm => Str} ;
RS = {s : Mood => Agr => Str ; c : Case} ;
SSlash = {
s : AAgr => Mood => Str ;
c2 : Compl
} ;
SC = {s : Case => Str} ; -- de dormir / à dormir
-- Sentence
Cl = Clause ;
ClSlash = SlashClause ;
Imp = {s : RPolarity => ImpForm => Gender => Str} ;
-- Question
QCl = QuestClause ;
IP = {s : Case => Str ; a : AAgr} ;
IComp = {s : AAgr => Str} ;
IDet = {s : Gender => Case => Str ; n : Number} ;
IQuant = {s : Number => Gender => Case => Str} ;
-- Relative
RCl = RelClause ;
RP = RelPron ;
-- Verb
VP = ResRomance.VP ;
VPSlash = ResRomance.VP ** {c2 : Compl} ;
Comp = {s : Agr => Str} ;
-- Adjective
AP = {s : AForm => Str ; isPre : Bool} ;
-- Noun
CN = {s : Number => Str ; g : Gender} ;
Pron = Pronoun ;
NP = NounPhrase ;
Det = {
s : Gender => Case => Str ;
n : Number ;
s2 : Str ; -- -ci
sp : Gender => Case => Str ; -- substantival: mien, mienne
isNeg : Bool -- negative element, e.g. aucun
} ;
Quant = {
s : Bool => Number => Gender => Case => Str ;
s2 : Str ;
sp : Number => Gender => Case => Str ;
isNeg : Bool -- negative element, e.g. aucun
} ;
Predet = {
s : AAgr => Case => Str ;
c : Case ; -- c : la plupart de
a : PAgr -- if an agr is forced, e.g. chacun de nous
} ;
Num = {s : Gender => Str ; isNum : Bool ; n : Number} ;
Card = {s : Gender => Str ; n : Number} ;
Ord = {s : AAgr => Str} ;
-- Numeral
Numeral = {s : CardOrd => Str ; n : Number} ;
Digits = {s : CardOrd => Str ; n : Number} ;
-- Structural
---b Conj = {s : Str ; n : Number} ;
---b DConj = {s1,s2 : Str ; n : Number} ;
Conj = {s1,s2 : Str ; n : Number} ;
Subj = {s : Str ; m : Mood} ;
Prep = {s : Str ; c : Case ; isDir : Bool} ;
-- Open lexical classes, e.g. Lexicon
V, VQ, VA = Verb ;
V2, VV, V2S, V2Q = Verb ** {c2 : Compl} ;
V3, V2A, V2V = Verb ** {c2,c3 : Compl} ;
VS = Verb ** {m : RPolarity => Mood} ;
A = {s : Degree => AForm => Str ; isPre : Bool} ;
A2 = {s : Degree => AForm => Str ; c2 : Compl} ;
N = Noun ;
N2 = Noun ** {c2 : Compl} ;
N3 = Noun ** {c2,c3 : Compl} ;
PN = {s : Str ; g : Gender} ;
-- tense augmented with passé simple
lincat
Temp = {s : Str ; t : RTense ; a : Anteriority} ;
Tense = {s : Str ; t : RTense} ;
linref
SSlash = \ss -> ss.s ! aagr Masc Sg ! Indic ++ ss.c2.s ;
---- ClSlash = \cls -> cls.s ! aagr Masc Sg ! DDir ! RPres ! Simul ! RPos ! Indic ++ cls.c2.s ;
VP = \vp -> infVP vp (agrP3 Masc Sg) ;
VPSlash = \vps -> infVP vps (agrP3 Masc Sg) ++ vps.c2.s ;
V, VS, VQ, VA = \v -> infVP (predV v) (agrP3 Masc Sg);
V2, V2A, V2Q, V2S = \v -> infVP (predV v) (agrP3 Masc Sg) ++ v.c2.s ;
V3 = \v -> infVP (predV v) (agrP3 Masc Sg) ++ v.c2.s ++ v.c3.s ;
VV = \v -> infVP (predV v) (agrP3 Masc Sg) ;
V2V = \v -> infVP (predV v) (agrP3 Masc Sg) ;
NP = \np -> (np.s ! Nom).comp ;
Conj = \c -> c.s2 ;
A = \a -> a.s ! Posit ! AF Masc Sg ;
A2 = \a -> a.s ! Posit ! AF Masc Sg ++ a.c2.s ;
N = \n -> n.s ! Sg ;
N2 = \n -> n.s ! Sg ++ n.c2.s ;
N3 = \n -> n.s ! Sg ++ n.c2.s ++ n.c3.s ;
}

114
lib/src/romance/exper/QuestionRomance.gf Normal file
View File

@@ -0,0 +1,114 @@
incomplete concrete QuestionRomance of Question =
CatRomance ** open CommonRomance, ResRomance, Prelude in {
flags optimize=all_subs ;
lin
QuestCl cl = cl ** {ip = [] ; isSent = True} ;
QuestVP qp vp = {np = heavyNP {s = qp.s ; a = agrP3 qp.a.g qp.a.n} ; vp = vp ; ip = [] ; isSent = False} ;
QuestSlash ip slash = slash ** {ip = ip.s ! slash.c2.c ; isSent = False} ;
{- ----
s = \\t,a,p =>
let
cl = oldClause slash ;
cls : Direct -> Str =
\d -> cl.s ! d ! t ! a ! p ! Indic ;
---- \d -> cl.s ! ip.a ! d ! t ! a ! p ! Indic ;
who = slash.c2.s ++ ip.s ! slash.c2.c
in table {
QDir => who ++ cls DInv ;
QIndir => who ++ cls DDir
}
-}
QuestIAdv iadv cl = cl ** {ip = iadv.s ; isSent = False} ;
{-
s = \\t,a,p,q =>
let
ord = case q of {
QDir => DInv ;
QIndir => DInv
} ;
cl = oldClause ncl ;
cls = cl.s ! ord ! t ! a ! p ! Indic ;
why = iadv.s
in why ++ cls
-}
QuestIComp icomp np = {np = np ; vp = predV copula ; ip = icomp.s ! complAgr np.a ; isSent = False} ;
{-
s = \\t,a,p,_ =>
let
vp = predV copula ;
cls = (mkClause (np.s ! Nom).comp np.hasClit np.isPol np.a vp).s !
DInv ! t ! a ! p ! Indic ;
why = icomp.s ! complAgr np.a ;
in why ++ cls
-}
PrepIP p ip = {
s = p.s ++ ip.s ! p.c
} ;
AdvIP ip adv = {
s = \\c => ip.s ! c ++ adv.s ;
a = ip.a
} ;
IdetCN idet cn =
let
g = cn.g ;
n = idet.n ;
a = aagr g n
in {
s = \\c => idet.s ! g ! c ++ cn.s ! n ;
a = a
} ;
IdetIP idet =
let
g = Masc ; ---- Fem in Extra
n = idet.n ;
a = aagr g n
in {
s = \\c => idet.s ! g ! c ;
a = a
} ;
IdetQuant idet num =
let
n = num.n ;
in {
s = \\g,c => idet.s ! n ! g ! c ++ num.s ! g ;
n = n
} ;
AdvIAdv i a = {s = i.s ++ a.s} ;
CompIAdv a = {s = \\_ => a.s} ;
CompIP p = {s = \\_ => p.s ! Nom} ;
lincat
QVP = ResRomance.VP ;
lin
ComplSlashIP vp ip = insertObject vp.c2 (heavyNP {s = ip.s ; a = {g = ip.a.g ; n = ip.a.n ; p = P3}}) vp ;
AdvQVP vp adv = insertAdv adv.s vp ;
AddAdvQVP vp adv = insertAdv adv.s vp ;
QuestQVP qp vp = {np = heavyNP {s = qp.s ; a = agrP3 qp.a.g qp.a.n} ; vp = vp ; ip = [] ; isSent = False} ; ----
{-
s = \\t,a,b,_ =>
let
cl = mkClause (qp.s ! Nom) False False (agrP3 qp.a.g qp.a.n) vp
in
cl.s ! DDir ! t ! a ! b ! Indic
-}
}

66
lib/src/romance/exper/RelativeRomance.gf Normal file
View File

@@ -0,0 +1,66 @@
incomplete concrete RelativeRomance of Relative =
CatRomance ** open Prelude, CommonRomance, ResRomance in {
flags optimize=all_subs ;
lin
RelCl cl = cl ** {c2 = complNom ; rp = \\aag => pronSuch ! aag ++ conjThat} ;
{-
let cl = oldClause ncl in {
s = \\ag,t,a,p,m => pronSuch ! complAgr ag ++ conjThat ++
cl.s ! DDir ! t ! a ! p ! m ;
c = Nom
} ;
-}
RelVP rp vp = {
np = heavyNP {s = rp.s ! False ! {g = Masc ; n = Sg} ; a = Ag rp.a.g rp.a.n P3} ; ---- agr,agr
vp = vp ;
rp = \\_ => [] ;
c2 = complNom
} ;
{-
--- more efficient to compile than case inside mkClause; see log.txt
case rp.hasAgr of {
True => {s = \\ag =>
(mkClause
(rp.s ! False ! complAgr ag ! Nom) False False
(Ag rp.a.g rp.a.n P3)
vp).s ! DDir ; c = Nom} ;
False => {s = \\ag =>
(mkClause
(rp.s ! False ! complAgr ag ! Nom) False False
ag
vp).s ! DDir ; c = Nom
}
} ;
-}
RelSlash rp slash = slash ** {rp = \\aag => rp.s ! False ! aag ! slash.c2.c ; c2 = complAcc} ;
{-
s = \\ag,t,a,p,m =>
let
aag = complAgr ag ;
cl = oldClause slash
in
slash.c2.s ++
rp.s ! False ! aag ! slash.c2.c ++
cl.s ! DDir ! t ! a ! p ! m ; --- ragr
---- slash.s ! aag ! DDir ! t ! a ! p ! m ; --- ragr
c = Acc
-}
FunRP p np rp = {
s = \\_,a,c => (np.s ! Nom).ton ++ p.s ++ rp.s ! True ! a ! p.c ;
a = complAgr np.a ;
hasAgr = True
} ;
IdRP = {
s = relPron ;
a = {g = Masc ; n = Sg} ;
hasAgr = False
} ;
}

353
lib/src/romance/exper/ResRomance.gf Normal file
View File

@@ -0,0 +1,353 @@
--1 Romance auxiliary operations.
--
interface ResRomance = DiffRomance ** open CommonRomance, Prelude in {
flags optimize=all ;
coding=utf8 ;
--2 Constants uniformly defined in terms of language-dependent constants
oper
nominative : Case = Nom ;
accusative : Case = Acc ;
NounPhrase : Type = {
s : Case => {c1,c2,comp,ton : Str} ;
a : Agr ;
hasClit : Bool ;
isPol : Bool ; --- only needed for French complement agr
isNeg : Bool --- needed for negative NP's such as "personne"
} ;
Pronoun : Type = {
s : Case => {c1,c2,comp,ton : Str} ;
a : Agr ;
hasClit : Bool ;
isPol : Bool ; --- only needed for French complement agr
poss : Number => Gender => Str ---- also: substantival
} ;
heavyNP : {s : Case => Str ; a : Agr} -> NounPhrase = heavyNPpol False ;
heavyNPpol : Bool -> {s : Case => Str ; a : Agr} -> NounPhrase = \isNeg,np -> {
s = \\c => {comp,ton = np.s ! c ; c1,c2 = []} ;
a = np.a ;
hasClit = False ;
isPol = False ;
isNeg = isNeg
} ;
Compl : Type = {s : Str ; c : Case ; isDir : Bool} ;
complAcc : Compl = {s = [] ; c = accusative ; isDir = True} ;
complGen : Compl = {s = [] ; c = genitive ; isDir = False} ;
complDat : Compl = {s = [] ; c = dative ; isDir = True} ;
complNom : Compl = {s = [] ; c = Nom ; isDir = False} ;
pn2np : {s : Str ; g : Gender} -> NounPhrase = pn2npPol False ;
pn2npNeg : {s : Str ; g : Gender} -> NounPhrase = pn2npPol True ;
pn2npPol : Bool -> {s : Str ; g : Gender} -> NounPhrase = \isNeg, pn -> heavyNPpol isNeg {
s = \\c => prepCase c ++ pn.s ;
a = agrP3 pn.g Sg
} ;
npform2case : NPForm -> Case = \p -> case p of {
Ton x => x ;
Poss _ => genitive ;
Aton x => x
} ;
case2npform : Case -> NPForm = \c -> case c of {
Nom => Ton Nom ;
Acc => Ton Acc ;
_ => Ton c
} ;
-- Pronouns in $NP$ lists are always in stressed forms.
stressedCase : NPForm -> NPForm = \c -> case c of {
Aton k => Ton k ;
_ => c
} ;
appCompl : Compl -> NounPhrase -> Str = \comp,np ->
comp.s ++ (np.s ! comp.c).ton ;
oper
predV : Verb -> VP = \verb ->
let
typ = verb.vtyp ;
in {
s = verb ;
agr = partAgr typ ;
neg = negation ;
clit1 = [] ;
clit2 = [] ;
clit3 = {s,imp = [] ; hasClit = False} ; --- refl is treated elsewhere
isNeg = False ;
comp = \\a => [] ;
ext = \\p => []
} ;
insertObject : Compl -> NounPhrase -> VP -> VP = \c,np,vp ->
let
obj = np.s ! c.c ;
in {
s = vp.s ;
agr = case <np.hasClit, c.isDir, c.c> of {
<True,True,Acc> => vpAgrClit np.a ;
_ => vp.agr -- must be dat
} ;
clit1 = vp.clit1 ++ obj.c1 ;
clit2 = vp.clit2 ++ obj.c2 ;
clit3 = addClit3 np.hasClit [] (imperClit np.a obj.c1 obj.c2) vp.clit3 ;
isNeg = orB vp.isNeg np.isNeg ;
comp = \\a => c.s ++ obj.comp ++ vp.comp ! a ;
neg = vp.neg ;
ext = vp.ext ;
} ;
insertComplement : (Agr => Str) -> VP -> VP = \co,vp -> {
s = vp.s ;
agr = vp.agr ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = vp.clit3 ;
isNeg = vp.isNeg ; --- can be in compl as well
neg = vp.neg ;
comp = \\a => vp.comp ! a ++ co ! a ;
ext = vp.ext ;
} ;
-- Agreement with preceding relative or interrogative:
-- "les femmes que j'ai aimées"
insertAgr : AAgr -> VP -> VP = \ag,vp -> {
s = vp.s ;
agr = vpAgrClit (agrP3 ag.g ag.n) ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = vp.clit3 ;
isNeg = vp.isNeg ;
neg = vp.neg ;
comp = vp.comp ;
ext = vp.ext ;
} ;
insertRefl : VP -> VP = \vp -> {
s = vp.s ** {vtyp = vRefl vp.s.vtyp} ;
agr = VPAgrSubj ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = vp.clit3 ;
isNeg = vp.isNeg ;
neg = vp.neg ;
comp = vp.comp ;
ext = vp.ext ;
} ;
insertAdv : Str -> VP -> VP = \co,vp -> {
s = vp.s ;
agr = vp.agr ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = vp.clit3 ;
isNeg = vp.isNeg ; --- adv could be neg
neg = vp.neg ;
comp = \\a => vp.comp ! a ++ co ;
ext = vp.ext ;
} ;
insertAdV : Str -> VP -> VP = \co,vp -> {
s = vp.s ;
agr = vp.agr ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = vp.clit3 ;
isNeg = vp.isNeg ;
neg = \\b => let vpn = vp.neg ! b in {p1 = vpn.p1 ; p2 = vpn.p2 ++ co} ;
comp = vp.comp ;
ext = vp.ext ;
} ;
insertClit3 : Str -> VP -> VP = \co,vp -> {
s = vp.s ;
agr = vp.agr ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = addClit3 True co vp.clit3.imp vp.clit3 ;
isNeg = vp.isNeg ;
neg = vp.neg ;
comp = vp.comp ;
ext = vp.ext ;
} ;
insertExtrapos : (RPolarity => Str) -> VP -> VP = \co,vp -> {
s = vp.s ;
agr = vp.agr ;
clit1 = vp.clit1 ;
clit2 = vp.clit2 ;
clit3 = vp.clit3 ;
isNeg = vp.isNeg ;
neg = vp.neg ;
comp = vp.comp ;
ext = \\p => vp.ext ! p ++ co ! p ;
} ;
mkVPSlash : Compl -> VP -> VP ** {c2 : Compl} = \c,vp -> vp ** {c2 = c} ;
----- new stuff 28/11/2014 -------------
Clause : Type = {np : NounPhrase ; vp : VP} ;
SlashClause : Type = Clause ** {c2 : Compl} ;
QuestClause : Type = Clause ** {ip : Str ; isSent : Bool} ; -- if IP is subject then it is np, and ip is empty
RelClause : Type = SlashClause ** {rp : AAgr => Str} ; -- if RP is subject then it is np, and rp is empty
mknClause : NounPhrase -> VP -> Clause = \np, vp -> {np = np ; vp = vp} ;
mknpClause : Str -> VP -> Clause = \s, vp -> mknClause (heavyNP {s = \\_ => s ; a = agrP3 Masc Sg}) vp ;
RelPron : Type = {s : Bool => AAgr => Case => Str ; a : AAgr ; hasAgr : Bool} ;
OldClause : Type = {s : Direct => RTense => Anteriority => RPolarity => Mood => Str} ;
OldQuestClause : Type = {s : QForm => RTense => Anteriority => RPolarity => Mood => Str} ;
OldRelClause : Type = {s : Agr => RTense => Anteriority => RPolarity => Mood => Str ; c : Case} ;
oldClause : Clause -> OldClause = \cl ->
let np = cl.np in
mkClausePol np.isNeg (np.s ! Nom).comp np.hasClit np.isPol np.a cl.vp ;
oldQuestClause : QuestClause -> OldQuestClause = \qcl ->
let
np = qcl.np ;
cl = mkClause (np.s ! Nom).comp False False np.a qcl.vp ;
in {
s = table {
QDir => \\t,a,r,m => qcl.ip ++ cl.s ! DInv ! t ! a ! r ! m ;
QIndir => \\t,a,r,m => case qcl.isSent of {True => subjIf ; _ => []} ++ qcl.ip ++ cl.s ! DDir ! t ! a ! r ! m
}
} ;
oldRelClause : RelClause -> OldRelClause = \rcl ->
let
np = rcl.np ;
cl = mkClause (np.s ! Nom).comp False False np.a rcl.vp ; ---- Ag rp.a.g rp.a.n P3
in {
s = \\agr => cl.s ! DDir ;
c = rcl.c2.c
} ;
---------------------------------------
mkClause : Str -> Bool -> Bool -> Agr -> VP ->
{s : Direct => RTense => Anteriority => RPolarity => Mood => Str} =
mkClausePol False ;
-- isNeg = True if subject NP is a negative element, e.g. "personne"
mkClausePol : Bool -> Str -> Bool -> Bool -> Agr -> VP ->
{s : Direct => RTense => Anteriority => RPolarity => Mood => Str} =
\isNeg, subj, hasClit, isPol, agr, vp -> {
s = \\d,te,a,b,m =>
let
pol : RPolarity = case <isNeg, vp.isNeg, b, d> of {
<_,True,RPos,_> => RNeg True ;
<True,_,RPos,DInv> => RNeg True ;
<True,_,RPos,_> => polNegDirSubj ;
_ => b
} ;
neg = vp.neg ! pol ;
gen = agr.g ;
num = agr.n ;
per = agr.p ;
particle = vp.s.p ;
compl = particle ++ case isPol of {
True => vp.comp ! {g = gen ; n = Sg ; p = per} ;
_ => vp.comp ! agr
} ;
ext = vp.ext ! b ;
vtyp = vp.s.vtyp ;
refl = case isVRefl vtyp of {
True => reflPron num per Acc ; ---- case ?
_ => []
} ;
clit = refl ++ vp.clit1 ++ vp.clit2 ++ vp.clit3.s ; ---- refl first?
verb = vp.s.s ;
vaux = auxVerb vp.s.vtyp ;
part = case vp.agr of {
VPAgrSubj => verb ! VPart agr.g agr.n ;
VPAgrClit g n => verb ! VPart g n
} ;
vps : Str * Str = case <te,a> of {
<RPast,Simul> => <verb ! VFin (VImperf m) num per, []> ; --# notpresent
<RPast,Anter> => <vaux ! VFin (VImperf m) num per, part> ; --# notpresent
<RFut,Simul> => <verb ! VFin (VFut) num per, []> ; --# notpresent
<RFut,Anter> => <vaux ! VFin (VFut) num per, part> ; --# notpresent
<RCond,Simul> => <verb ! VFin (VCondit) num per, []> ; --# notpresent
<RCond,Anter> => <vaux ! VFin (VCondit) num per, part> ; --# notpresent
<RPasse,Simul> => <verb ! VFin (VPasse) num per, []> ; --# notpresent
<RPasse,Anter> => <vaux ! VFin (VPasse) num per, part> ; --# notpresent
<RPres,Anter> => <vaux ! VFin (VPres m) num per, part> ; --# notpresent
<RPres,Simul> => <verb ! VFin (VPres m) num per, []>
} ;
fin = vps.p1 ;
inf = vps.p2 ;
in
case d of {
DDir =>
subj ++ neg.p1 ++ clit ++ fin ++ neg.p2 ++ inf ++ compl ++ ext ;
DInv =>
invertedClause vp.s.vtyp <te, a, num, per> hasClit neg clit fin inf compl subj ext
}
} ;
--- in French, pronouns should
--- have a "-" with possibly a special verb form with "t":
--- "comment fera-t-il" vs. "comment fera Pierre"
infVP : VP -> Agr -> Str = nominalVP VInfin ;
gerVP : VP -> Agr -> Str = nominalVP (\_ -> VGer) ;
nominalVP : (Bool -> VF) -> VP -> Agr -> Str = \vf,vp,agr ->
let
iform = orB vp.clit3.hasClit (isVRefl vp.s.vtyp) ;
inf = vp.s.s ! vf iform ;
neg = vp.neg ! RPos ; --- Neg not in API
obj = vp.s.p ++ vp.comp ! agr ++ vp.ext ! RPos ; ---- pol
refl = case isVRefl vp.s.vtyp of {
True => reflPron agr.n agr.p Acc ; ---- case ?
_ => []
} ;
in
neg.p1 ++ neg.p2 ++ clitInf iform (refl ++ vp.clit1 ++ vp.clit2 ++ vp.clit3.s) inf ++ obj ; -- ne pas dormant
}
-- insertObject:
-- p -cat=Cl -tr "la femme te l' envoie"
-- PredVP (DetCN (DetSg DefSg NoOrd) (UseN woman_N))
-- (ComplV3 send_V3 (UsePron he_Pron) (UsePron thou_Pron))
-- la femme te l' a envoyé
--
-- p -cat=Cl -tr "la femme te lui envoie"
-- PredVP (DetCN (DetSg DefSg NoOrd) (UseN woman_N))
-- (ComplV3 send_V3 (UsePron thou_Pron) (UsePron he_Pron))
-- la femme te lui a envoyée

69
lib/src/romance/exper/SentenceRomance.gf Normal file
View File

@@ -0,0 +1,69 @@
incomplete concrete SentenceRomance of Sentence =
CatRomance ** open Prelude, CommonRomance, ResRomance in {
flags optimize=all_subs ;
coding=utf8 ;
lin
PredVP np vp = mknClause np vp ;
PredSCVP sc vp = mknClause (heavyNP {s = sc.s ; a = agrP3 Masc Sg}) vp ;
ImpVP vp = {
s = \\p,i,g => case i of {
ImpF n b => mkImperative b P2 vp ! p ! g ! n ---- AgPol ?
}
} ;
SlashVP np vps = {np = np ; vp = vps ; c2 = vps.c2} ;
AdvSlash slash adv = slash ** {vp = insertAdv adv.s slash.vp} ;
SlashPrep cl prep = cl ** {c2 = {s = prep.s ; c = prep.c ; isDir = False}} ;
SlashVS np vs slash = {
np = np ;
vp = insertExtrapos (\\b => conjThat ++ slash.s ! {g = Masc ; n = Sg} ! (vs.m ! b)) (predV vs) ; ---- aag
c2 = slash.c2
} ;
{-
{s = \\ag =>
(mkClausePol np.isNeg
(np.s ! Nom).comp False np.isPol np.a
(insertExtrapos (\\b => conjThat ++ slash.s ! ag ! (vs.m ! b))
(predV vs))
).s ;
c2 = slash.c2
} ;
-}
EmbedS s = {s = \\_ => conjThat ++ s.s ! Indic} ; --- mood
EmbedQS qs = {s = \\_ => qs.s ! QIndir} ;
EmbedVP vp = {s = \\c => prepCase c ++ infVP vp (agrP3 Masc Sg)} ; --- agr ---- compl
UseCl t p ncl = let cl = oldClause ncl in {
s = \\o => t.s ++ p.s ++ cl.s ! DDir ! t.t ! t.a ! p.p ! o
} ;
UseQCl t p qcl = let cl = oldQuestClause qcl in {
s = \\q => t.s ++ p.s ++ cl.s ! q ! t.t ! t.a ! p.p ! Indic
} ;
UseRCl t p rcl = let cl = oldRelClause rcl in {
s = \\r,ag => t.s ++ p.s ++ cl.s ! ag ! t.t ! t.a ! p.p ! r ;
c = cl.c
} ;
UseSlash t p ncl = let cl = oldClause ncl in {
s = \\ag,mo =>
t.s ++ p.s ++ cl.s ! DDir ! t.t ! t.a ! p.p ! mo ;
---- t.s ++ p.s ++ cl.s ! ag ! DDir ! t.t ! t.a ! p.p ! mo ;
c2 = ncl.c2
} ;
AdvS a s = {s = \\o => a.s ++ s.s ! o} ;
ExtAdvS a s = {s = \\o => a.s ++ "," ++ s.s ! o} ;
SSubjS a s b = {s = \\m => a.s ! m ++ s.s ++ b.s ! s.m} ;
RelS s r = {
s = \\o => s.s ! o ++ "," ++ partQIndir ++ r.s ! Indic ! agrP3 Masc Sg
} ;
}