From 76abd1e66f4273fa77c6e51cfe37935565e17c56 Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 30 Nov 2014 12:53:50 +0000 Subject: [PATCH] eliminated one parameter from Fre, resulting in twice as fast compilation --- lib/src/french/DiffFre.gf | 42 +++-- lib/src/french/IrregFre.gf | 10 +- lib/src/french/MorphoFre.gf | 6 +- lib/src/french/ParadigmsFre.gf | 6 +- lib/src/italian/DiffIta.gf | 6 +- lib/src/romance/DiffRomance.gf | 8 +- lib/src/romance/ResRomance.gf | 13 +- lib/src/romance/SentenceRomance.gf | 9 +- lib/src/romance/exper/CatRomance.gf | 4 +- lib/src/romance/exper/RelativeRomance.gf | 6 +- lib/src/romance/exper/ResRomance.gf | 230 ++++++++++++++++++----- lib/src/romance/exper/SentenceRomance.gf | 30 +-- 12 files changed, 260 insertions(+), 110 deletions(-) diff --git a/lib/src/french/DiffFre.gf b/lib/src/french/DiffFre.gf index e920ebdb1..f85bd6532 100644 --- a/lib/src/french/DiffFre.gf +++ b/lib/src/french/DiffFre.gf @@ -2,7 +2,8 @@ instance DiffFre of DiffRomance - [ imperClit, - invertedClause + invertedClause, + verbHyphen ] = open CommonRomance, PhonoFre, Prelude in { @@ -11,9 +12,10 @@ instance DiffFre of DiffRomance - [ param Prepos = P_de | P_a | PNul ; - VType = VTyp VAux Bool ; -- True means that -t- is required as in va-t-il, alla-t-il + VType = VTyp VAux VBool ; -- True means that -t- is required as in va-t-il, alla-t-il VAux = VHabere | VEsse | VRefl ; - + VBool = VFalse ; + oper VTrue = VFalse ; oper dative : Case = CPrep P_a ; genitive : Case = CPrep P_de ; @@ -228,33 +230,33 @@ instance DiffFre of DiffRomance - [ <_,Pl,P3> => cases3 "les" "leur" "eux" } ; - vRefl : VType -> VType = \t -> VTyp VRefl (getVTypT t) ; + vRefl : VType -> VType = \t -> VTyp VRefl VFalse ; ---- (getVTypT t) ; isVRefl : VType -> Bool = \ty -> case ty of { VTyp VRefl _ => True ; _ => False } ; - getVTypT : VType -> Bool = \t -> case t of {VTyp _ b => b} ; -- only in Fre + getVTypT : VType -> VBool = \t -> case t of {VTyp _ b => b} ; -- only in Fre auxPassive : Verb = copula ; - copula : Verb = {s = table VF ["être";"être";"suis";"es";"est";"sommes";"êtes";"sont";"sois";"sois" + copula : Verb = {s = table VF ["être";bindHyphen;"suis";"es";"est";"sommes";"êtes";"sont";"sois";"sois" ;"soit";"soyons";"soyez";"soient"; "étais";"étais";"était";"étions";"étiez";"étaient";--# notpresent "fusse";"fusses";"fût";"fussions";"fussiez";"fussent";--# notpresent "fus";"fus";"fut";"fûmes";"fûtes";"furent";--# notpresent "serai";"seras";"sera";"serons";"serez";"seront";--# notpresent "serais";"serais";"serait";"serions";"seriez";"seraient";--# notpresent -"sois";"soyons";"soyez";"été";"étés";"étée";"étées";"étant";"étant"]; vtyp=VTyp VHabere False ; p = []} ; +"sois";"soyons";"soyez";"été";"étés";"étée";"étées";"étant";"étant"]; vtyp=VTyp VHabere VFalse ; p = []} ; - avoir_V : Verb = {s=table VF ["avoir";"avoir";"ai";"as";"a";"avons";"avez";"ont";"aie";"aies";"ait" + avoir_V : Verb = {s=table VF ["avoir";bindHyphensT;"ai";"as";"a";"avons";"avez";"ont";"aie";"aies";"ait" ;"ayons";"ayez";"aient"; "avais";"avais";"avait";"avions";"aviez";"avaient"; --# notpresent "eusse";"eusses";"eût";"eussions";"eussiez";"eussent";--# notpresent "eus";"eus";"eut";"eûmes";"eûtes";"eurent";--# notpresent "aurai";"auras";"aura";"aurons";"aurez";"auront";--# notpresent "aurais";"aurais";"aurait";"aurions";"auriez";"auraient";--# notpresent -"aie";"ayons";"ayez";"eu";"eus";"eue";"eues";"ayant";"ayant"];vtyp=VTyp VHabere True ; p = []} ; ---- a-t-il eut-il +"aie";"ayons";"ayez";"eu";"eus";"eue";"eues";"ayant";"ayant"];vtyp=VTyp VHabere VTrue ; p = []} ; ---- a-t-il eut-il datClit = "y" ; genClit = "en" ; @@ -273,22 +275,22 @@ instance DiffFre of DiffRomance - [ polNegDirSubj = RNeg True ; invertedClause : - VType -> (RTense * Anteriority * Number * Person) -> Bool -> (Str * Str) -> (clit,fin,inf,compl,subj,ext : Str) -> Str = - \vtyp,vform,hasClit,neg,clit,fin,inf,compl,subj,ext -> case of { + VType -> (RTense * Anteriority * Number * Person) -> Bool -> (Str * Str) -> Str -> (clit,fin,inf,compl,subj,ext : Str) -> Str = + \vtyp,vform,hasClit,neg,bindHyph,clit,fin,inf,compl,subj,ext -> case of { - -- parle-t-il - , True> => - neg.p1 ++ clit ++ fin ++ bindHyphensT ++ subj ++ neg.p2 ++ inf ++ compl ++ ext ; + -- parle-t-il - some verbs + , True> => + neg.p1 ++ clit ++ fin ++ bindHyph ++ subj ++ neg.p2 ++ inf ++ compl ++ ext ; - -- parla-t-il - , True> => --# notpresent - neg.p1 ++ clit ++ fin ++ bindHyphensT ++ subj ++ neg.p2 ++ inf ++ compl ++ ext ; --# notpresent + -- parla-t-il - some verbs + , True> => --# notpresent + neg.p1 ++ clit ++ fin ++ bindHyph ++ subj ++ neg.p2 ++ inf ++ compl ++ ext ; --# notpresent - -- fera-t-il, sera-t-il venu + -- fera-t-il, sera-t-il venu - all verbss <_, , True> => --# notpresent neg.p1 ++ clit ++ fin ++ bindHyphensT ++ subj ++ neg.p2 ++ inf ++ compl ++ ext ; --# notpresent - -- a-t-il fait + -- a-t-il fait - all "avoir" verbs , True> => --# notpresent neg.p1 ++ clit ++ fin ++ bindHyphensT ++ subj ++ neg.p2 ++ inf ++ compl ++ ext ; --# notpresent @@ -302,4 +304,6 @@ instance DiffFre of DiffRomance - [ bindHyphensT : Str = bindHyphen ++ "t" ++ bindHyphen ; + verbHyphen : Verb -> Str = \v -> v.s ! (VInfin True) ; --- kluge: use this field to store - or -t- + } diff --git a/lib/src/french/IrregFre.gf b/lib/src/french/IrregFre.gf index cae609f8e..c6bdcc3d9 100644 --- a/lib/src/french/IrregFre.gf +++ b/lib/src/french/IrregFre.gf @@ -24,8 +24,8 @@ lin adjoindre_V2 = v_besch58 "adjoindre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; admettre_V2 = v_besch56 "admettre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; advenir_V = v_besch23 "advenir" ** {vtyp = vEsse ; p = [] ; lock_V = <>} ; - aller_V = v_besch22 "aller" ** {vtyp = VTyp VEsse True ; p = [] ; lock_V = <>} ; - apercevoir_V2 = v_besch38 "apercevoir" ** {vtyp = VTyp VRefl False ; p = [] ; lock_V2 = <> ; c2 = complGen} ; + aller_V = v_besch22 "aller" ** {vtyp = VTyp VEsse VTrue ; p = [] ; lock_V = <>} ; + apercevoir_V2 = v_besch38 "apercevoir" ** {vtyp = VTyp VRefl VFalse ; p = [] ; lock_V2 = <> ; c2 = complGen} ; apparaître_V = v_besch64 "apparaître" ** {vtyp = vHabere ; p = [] ; lock_V = <>} ; appartenir_V2 = v_besch23 "appartenir" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complDat} ; appendre_V2 = v_besch53 "appendre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; @@ -35,7 +35,7 @@ lin astreindre_V2 = v_besch57 "astreindre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; atteindre_V2 = v_besch57 "atteindre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; attendre_V2 = v_besch53 "attendre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; --- Dat? - avoir_V2 = v_besch1 "avoir" ** {vtyp = VTyp VHabere True ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; + avoir_V2 = v_besch1 "avoir" ** {vtyp = VTyp VHabere VTrue ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; battre_V2 = v_besch55 "battre" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; boire_V2 = v_besch69 "boire" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; bouillir_V2 = v_besch31 "bouillir" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; @@ -394,6 +394,6 @@ lin vouloir_V2 = v_besch48 "vouloir" ** {vtyp = vHabere ; p = [] ; lock_V2 = <> ; c2 = complAcc} ; oper - vHabere = VTyp VHabere False ; - vEsse = VTyp VEsse False ; + vHabere = VTyp VHabere VFalse ; + vEsse = VTyp VEsse VFalse ; } diff --git a/lib/src/french/MorphoFre.gf b/lib/src/french/MorphoFre.gf index c6884cf39..0f58d9352 100644 --- a/lib/src/french/MorphoFre.gf +++ b/lib/src/french/MorphoFre.gf @@ -234,7 +234,11 @@ param oper vvf : (VForm => Str) -> (VF => Str) = \aller -> table { - VInfin _ => aller ! Inf ; + VInfin True => case last (aller ! Indi Presn Sg P3) of { --- terrible hack to store the binding here... 30/11/2014 + "a" | "e" => bindHyphensT ; -- parle-t-il, va-t-il + _ => bindHyphen -- prend-il + } ; + VInfin False => aller ! Inf ; VFin (VPres Indic) n p => aller ! Indi Presn n p ; VFin (VPres Subjunct) n p => aller ! Subjo SPres n p ; VFin (VImperf Indic) n p => aller ! Indi Imparf n p ; --# notpresent diff --git a/lib/src/french/ParadigmsFre.gf b/lib/src/french/ParadigmsFre.gf index b6cd7cbe1..5037d2461 100644 --- a/lib/src/french/ParadigmsFre.gf +++ b/lib/src/french/ParadigmsFre.gf @@ -515,9 +515,9 @@ oper dirV3 : V -> Prep -> V3 ; -- donner,_,à dirdirV3 : V -> V3 ; -- donner,_,_ - getVerbT : (VF => Str) -> Bool = \v -> case last (v ! (VFin (VPres Indic) Sg P3)) of { - "a" | "e" => True ; -- parle-t-il, va-t-il - _ => False -- prend-il + getVerbT : (VF => Str) -> VBool = \v -> case last (v ! (VFin (VPres Indic) Sg P3)) of { + "a" | "e" => VTrue ; -- parle-t-il, va-t-il + _ => VFalse -- prend-il } ; diff --git a/lib/src/italian/DiffIta.gf b/lib/src/italian/DiffIta.gf index 594534702..694ad03bc 100644 --- a/lib/src/italian/DiffIta.gf +++ b/lib/src/italian/DiffIta.gf @@ -1,10 +1,14 @@ --# -path=.:../romance:../abstract:../common:prelude -instance DiffIta of DiffRomance = open CommonRomance, PhonoIta, BeschIta, Prelude in { +instance DiffIta of DiffRomance - [contractInf] = open CommonRomance, PhonoIta, BeschIta, Prelude in { flags optimize=all ; coding=utf8 ; +------ +-- exception to interface + oper contractInf : Bool -> Bool -> Bool = orB ; -- Ita has special contracted inf forms with clitics +------ param Prepos = P_di | P_a | P_da | P_in | P_su | P_con ; VType = VHabere | VEsse | VRefl ; diff --git a/lib/src/romance/DiffRomance.gf b/lib/src/romance/DiffRomance.gf index 74e0c7106..8b2380397 100644 --- a/lib/src/romance/DiffRomance.gf +++ b/lib/src/romance/DiffRomance.gf @@ -145,8 +145,12 @@ oper -- inverted clause order, only deviant in Fre where also the intervening -t- has to be taken to account invertedClause : - VType -> (RTense * Anteriority * Number * Person) -> Bool -> (Str * Str) -> (clit,fin,inf,compl,subj,ext : Str) -> Str = - \_,_,_,neg,clit,fin,inf,compl,subj,ext -> neg.p1 ++ clit ++ fin ++ neg.p2 ++ inf ++ compl ++ subj ++ ext ; + VType -> (RTense * Anteriority * Number * Person) -> Bool -> (Str * Str) -> Str -> (clit,fin,inf,compl,subj,ext : Str) -> Str = + \_,_,_,neg,_,clit,fin,inf,compl,subj,ext -> neg.p1 ++ clit ++ fin ++ neg.p2 ++ inf ++ compl ++ subj ++ ext ; + + verbHyphen : Verb -> Str = \v -> [] ; -- in Fre, - or -t- + + contractInf : Bool -> Bool -> Bool = \_,_ -> False ; -- only True in Ita, by orB } diff --git a/lib/src/romance/ResRomance.gf b/lib/src/romance/ResRomance.gf index dbc43ba8a..021fe0e94 100644 --- a/lib/src/romance/ResRomance.gf +++ b/lib/src/romance/ResRomance.gf @@ -263,18 +263,20 @@ oper fin = vps.p1 ; inf = vps.p2 ; + hypt = verbHyphen vp.s ; -- in French, -t- in some cases, otherwise - ; empty in other langs + in case d of { DDir => subj ++ neg.p1 ++ clit ++ fin ++ neg.p2 ++ inf ++ compl ++ ext ; DInv => - invertedClause vp.s.vtyp hasClit neg clit fin inf compl subj ext + invertedClause vp.s.vtyp hasClit neg hypt 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" +-- in French, pronouns +-- have a "-" with possibly a special verb form with "t": +-- "comment fera-t-il" vs. "comment fera Pierre" infVP : VP -> Agr -> Str = nominalVP VInfin ; @@ -282,7 +284,8 @@ oper nominalVP : (Bool -> VF) -> VP -> Agr -> Str = \vf,vp,agr -> let - iform = orB vp.clit3.hasClit (isVRefl vp.s.vtyp) ; + ----iform = orB vp.clit3.hasClit (isVRefl vp.s.vtyp) ; + iform = contractInf 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 diff --git a/lib/src/romance/SentenceRomance.gf b/lib/src/romance/SentenceRomance.gf index 3191d5da6..12d33429f 100644 --- a/lib/src/romance/SentenceRomance.gf +++ b/lib/src/romance/SentenceRomance.gf @@ -108,7 +108,7 @@ incomplete concrete SentenceRomance of Sentence = VPAgrClit g n => verb ! VPart g n } ; - vps : Str * Str = case of { + vpss : Str * Str = case of { => ; --# notpresent => ; --# notpresent @@ -121,15 +121,16 @@ incomplete concrete SentenceRomance of Sentence = => ; --# notpresent => } ; - fin = vps.p1 ; - inf = vps.p2 ; + fin = vpss.p1 ; + inf = vpss.p2 ; + hypt = verbHyphen vp.s ; -- in French, -t- in some cases, otherwise - ; empty in other langs in case d of { DDir => subj ++ neg.p1 ++ clit ++ fin ++ neg.p2 ++ inf ++ compl ++ ext ; DInv => - invertedClause vp.s.vtyp hasClit neg clit fin inf compl subj ext + invertedClause vp.s.vtyp hasClit neg hypt clit fin inf compl subj ext } } ; diff --git a/lib/src/romance/exper/CatRomance.gf b/lib/src/romance/exper/CatRomance.gf index 090216d52..600535127 100644 --- a/lib/src/romance/exper/CatRomance.gf +++ b/lib/src/romance/exper/CatRomance.gf @@ -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) ; diff --git a/lib/src/romance/exper/RelativeRomance.gf b/lib/src/romance/exper/RelativeRomance.gf index cb6f78d00..93ba685f3 100644 --- a/lib/src/romance/exper/RelativeRomance.gf +++ b/lib/src/romance/exper/RelativeRomance.gf @@ -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 => diff --git a/lib/src/romance/exper/ResRomance.gf b/lib/src/romance/exper/ResRomance.gf index 4877854cc..48204d590 100644 --- a/lib/src/romance/exper/ResRomance.gf +++ b/lib/src/romance/exper/ResRomance.gf @@ -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 of { + <_,True,RPos,_> => RNeg True ; + => RNeg True ; + => 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 of { + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => ; --# notpresent + => + } ; + + 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 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 + +-} + } diff --git a/lib/src/romance/exper/SentenceRomance.gf b/lib/src/romance/exper/SentenceRomance.gf index e0b0d96ba..9c7f569bd 100644 --- a/lib/src/romance/exper/SentenceRomance.gf +++ b/lib/src/romance/exper/SentenceRomance.gf @@ -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} ;