mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-01 15:22:50 -06:00
eliminated one parameter from Fre, resulting in twice as fast compilation
This commit is contained in:
@@ -16,7 +16,7 @@ incomplete concrete CatRomance of Cat = CommonX - [SC,Pol]
|
||||
QS = {s : QForm => Str} ;
|
||||
RS = {s : Mood => Agr => Str ; c : Case} ;
|
||||
SSlash = {
|
||||
s : AAgr => Mood => Str ;
|
||||
s : Mood => Str ; ---- AAgr => Mood => Str ;
|
||||
c2 : Compl
|
||||
} ;
|
||||
|
||||
@@ -112,7 +112,7 @@ incomplete concrete CatRomance of Cat = CommonX - [SC,Pol]
|
||||
Tense = {s : Str ; t : RTense} ;
|
||||
|
||||
linref
|
||||
SSlash = \ss -> ss.s ! aagr Masc Sg ! Indic ++ ss.c2.s ;
|
||||
SSlash = \ss -> ss.s ! 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) ;
|
||||
|
||||
@@ -5,7 +5,7 @@ incomplete concrete RelativeRomance of Relative =
|
||||
|
||||
lin
|
||||
|
||||
RelCl cl = cl ** {c2 = complNom ; rp = \\aag => pronSuch ! aag ++ conjThat} ;
|
||||
RelCl cl = cl ** {c = Nom ; rp = \\aag => pronSuch ! aag ++ conjThat} ;
|
||||
{-
|
||||
let cl = oldClause ncl in {
|
||||
s = \\ag,t,a,p,m => pronSuch ! complAgr ag ++ conjThat ++
|
||||
@@ -18,7 +18,7 @@ let cl = oldClause ncl in {
|
||||
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
|
||||
c = Nom
|
||||
} ;
|
||||
{-
|
||||
--- more efficient to compile than case inside mkClause; see log.txt
|
||||
@@ -37,7 +37,7 @@ case rp.hasAgr of {
|
||||
} ;
|
||||
-}
|
||||
|
||||
RelSlash rp slash = slash ** {rp = \\aag => rp.s ! False ! aag ! slash.c2.c ; c2 = complAcc} ;
|
||||
RelSlash rp slash = slash ** {rp = \\aag => rp.s ! False ! aag ! slash.c2.c ; c = Acc} ;
|
||||
|
||||
{-
|
||||
s = \\ag,t,a,p,m =>
|
||||
|
||||
@@ -201,51 +201,6 @@ oper
|
||||
|
||||
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 ;
|
||||
@@ -338,6 +293,191 @@ oper
|
||||
} ;
|
||||
in
|
||||
neg.p1 ++ neg.p2 ++ clitInf iform (refl ++ vp.clit1 ++ vp.clit2 ++ vp.clit3.s) inf ++ obj ; -- ne pas dormant
|
||||
|
||||
----- new stuff 28/11/2014 -------------
|
||||
----- discontinuous clauses ------------
|
||||
|
||||
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 = Clause ** {rp : AAgr => Str ; c : Case} ; -- 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} ;
|
||||
|
||||
mkSentence : Direct -> RTense -> Anteriority -> RPolarity -> Mood -> Clause -> Str = \d,te,a,b,m,cl ->
|
||||
let
|
||||
np = cl.np ;
|
||||
isNeg = np.isNeg ;
|
||||
subj = (cl.np.s ! Nom).comp ;
|
||||
hasClit = np.hasClit ;
|
||||
isPol = np.isPol ;
|
||||
agr = np.a ;
|
||||
vp = cl.vp ;
|
||||
|
||||
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
|
||||
}
|
||||
;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
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.c
|
||||
} ; --3456000 (16800,3360)
|
||||
|
||||
---------------------------------------
|
||||
-- compiling LangFre
|
||||
-- v0: 646666 msec (old LangFre)
|
||||
-- v02: 317625 msec (old with VBool)
|
||||
-- v1: 258153 msec
|
||||
-- v2: 175677 msec UseCl 345600 (5040,5040) UseQCl 691200 (6720,6720) UseRCl 1728000 (16800,3360)
|
||||
-- v3: 169949 msec
|
||||
-- v4: 85209 msec (with VBool)
|
||||
|
||||
{-
|
||||
v0
|
||||
7167263 french/SentenceFre.gfo
|
||||
208919 french/QuestionFre.gfo
|
||||
876960 french/RelativeFre.gfo
|
||||
8253142 total
|
||||
|
||||
v0.2
|
||||
7032583 french/SentenceFre.gfo
|
||||
205086 french/QuestionFre.gfo
|
||||
876660 french/RelativeFre.gfo
|
||||
8114329 total
|
||||
|
||||
v2
|
||||
23476139 french/SentenceFre.gfo
|
||||
1150969 french/QuestionFre.gfo
|
||||
1282029 french/RelativeFre.gfo
|
||||
25909137 total
|
||||
v3
|
||||
23475961 french/SentenceFre.gfo
|
||||
1150969 french/QuestionFre.gfo
|
||||
1282029 french/RelativeFre.gfo
|
||||
25908959 total
|
||||
v4
|
||||
12652021 french/SentenceFre.gfo
|
||||
567152 french/QuestionFre.gfo
|
||||
628749 french/RelativeFre.gfo
|
||||
13847922 total
|
||||
|
||||
Ita
|
||||
324019 msec
|
||||
2671533 italian/SentenceIta.gfo
|
||||
130526 italian/QuestionIta.gfo
|
||||
606895 italian/RelativeIta.gfo
|
||||
3408954 total
|
||||
|
||||
Spa
|
||||
112362 msec
|
||||
1541743 spanish/SentenceSpa.gfo
|
||||
89561 spanish/QuestionSpa.gfo
|
||||
430675 spanish/RelativeSpa.gfo
|
||||
2061979 total
|
||||
|
||||
|
||||
VType = VTyp VAux Bool
|
||||
|
||||
VPAgr =
|
||||
VPAgrSubj -- elle est partie, elle s'est vue
|
||||
| VPAgrClit Gender Number ; -- elle a dormi; elle les a vues
|
||||
|
||||
partAgr : VType -> VPAgr
|
||||
vpAgrClit : Agr -> VPAgr
|
||||
pronArg : Number -> Person -> CAgr -> CAgr -> Str * Str * Bool
|
||||
vRefl : VType -> VType
|
||||
isVRefl : VType -> Bool
|
||||
getVTypT : VType -> Bool = \t -> case t of {VTyp _ b => b} ; -- only in Fre
|
||||
|
||||
-}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
@@ -23,39 +23,29 @@ incomplete concrete SentenceRomance of Sentence =
|
||||
|
||||
SlashVS np vs slash = {
|
||||
np = np ;
|
||||
vp = insertExtrapos (\\b => conjThat ++ slash.s ! {g = Masc ; n = Sg} ! (vs.m ! b)) (predV vs) ; ---- aag
|
||||
vp = insertExtrapos (\\b => conjThat ++ slash.s ! (vs.m ! b)) (predV vs) ; ---- agr of slash ??
|
||||
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
|
||||
} ;
|
||||
UseCl t p cl = {s = \\m => t.s ++ p.s ++ mkSentence DDir t.t t.a p.p m cl} ;
|
||||
|
||||
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
|
||||
} ;
|
||||
|
||||
UseSlash t p cl = {
|
||||
s = \\m => t.s ++ p.s ++ mkSentence DDir t.t t.a p.p m cl ;
|
||||
c2 = cl.c2
|
||||
} ;
|
||||
|
||||
AdvS a s = {s = \\o => a.s ++ s.s ! o} ;
|
||||
ExtAdvS a s = {s = \\o => a.s ++ "," ++ s.s ! o} ;
|
||||
|
||||
Reference in New Issue
Block a user