summaryrefslogtreecommitdiff
path: root/old-lib/resource/romance/ResRomance.gf
diff options
context:
space:
mode:
Diffstat (limited to 'old-lib/resource/romance/ResRomance.gf')
-rw-r--r--old-lib/resource/romance/ResRomance.gf299
1 files changed, 299 insertions, 0 deletions
diff --git a/old-lib/resource/romance/ResRomance.gf b/old-lib/resource/romance/ResRomance.gf
new file mode 100644
index 000000000..73ec6c8db
--- /dev/null
+++ b/old-lib/resource/romance/ResRomance.gf
@@ -0,0 +1,299 @@
+--1 Romance auxiliary operations.
+--
+
+interface ResRomance = DiffRomance ** open CommonRomance, Prelude in {
+
+flags optimize=all ;
+
+--2 Constants uniformly defined in terms of language-dependent constants
+
+oper
+
+ nominative : Case = Nom ;
+ accusative : Case = Acc ;
+
+ Pronoun = {s : NPForm => Str ; a : Agr ; hasClit : Bool} ;
+
+ 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} ;
+
+ pn2np : {s : Str ; g : Gender} -> Pronoun = \pn -> {
+ s = \\c => prepCase (npform2case c) ++ pn.s ;
+ a = agrP3 pn.g Sg ;
+ hasClit = False
+ } ;
+
+ 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 -> (NPForm => Str) -> Str = \comp,np ->
+ comp.s ++ np ! Ton comp.c ;
+
+ oper
+
+ VP : Type = {
+ s : Verb ;
+ agr : VPAgr ; -- dit/dite dep. on verb, subj, and clitic
+ neg : Polarity => (Str * Str) ; -- ne-pas
+ clAcc : CAgr ; -- le/se
+ clDat : CAgr ; -- lui
+ clit2 : Str ; -- y en
+ comp : Agr => Str ; -- content(e) ; à ma mère ; hier
+ ext : Polarity => Str ; -- que je dors / que je dorme
+ } ;
+
+
+ useVP : VP -> VPC = \vp ->
+ let
+ verb = vp.s ;
+ vfin : TMood -> Agr -> Str = \tm,a -> verb.s ! VFin tm a.n a.p ;
+ vpart : AAgr -> Str = \a -> verb.s ! VPart a.g a.n ;
+ vinf : Bool -> Str = \b -> verb.s ! VInfin b ;
+ vger = verb.s ! VGer ;
+
+ typ = verb.vtyp ;
+ aux = auxVerb typ ;
+
+ habet : TMood -> Agr -> Str = \tm,a -> aux ! VFin tm a.n a.p ;
+ habere : Str = aux ! VInfin False ;
+
+ vimp : Agr -> Str = \a -> case <a.n,a.p> of {
+ <Pl,P1> => verb.s ! VImper PlP1 ;
+ <_, P3> => verb.s ! VFin (VPres Conjunct) a.n P3 ;
+ <Sg,_> => verb.s ! VImper SgP2 ;
+ <Pl,_> => verb.s ! VImper PlP2
+ } ;
+
+ vf : (Agr -> Str) -> (AAgr -> Str) -> {
+ fin : Agr => Str ;
+ inf : AAgr => Str
+ } =
+ \fin,inf -> {
+ fin = \\a => fin a ;
+ inf = \\a => inf a
+ } ;
+
+ in {
+ s = table {
+ VPFinite t Simul => vf (vfin t) (\_ -> []) ;
+ VPFinite t Anter => vf (habet t) vpart ; --# notpresent
+ VPInfinit Anter b=> vf (\_ -> []) (\a -> habere ++ vpart a) ; --# notpresent
+ VPImperat => vf vimp (\_ -> []) ;
+ VPGerund => vf (\_ -> []) (\_ -> vger) ;
+ VPInfinit Simul b=> vf (\_ -> []) (\_ -> vinf b)
+ } ;
+ agr = vp.agr ; -- partAgr typ ;
+ neg = vp.neg ; -- negation ;
+ clAcc = vp.clAcc ; -- case isVRefl typ of {
+ -- True => CRefl ;
+ -- _ => CNone
+ -- } ;
+ clDat = vp.clDat ; -- CNone ; --- no dative refls
+ clit2 = vp.clit2 ; -- [] ;
+ comp = vp.comp ; -- \\a => [] ;
+ ext = vp.ext -- \\p => []
+ } ;
+
+ predV : Verb -> VP = \verb ->
+ let
+ typ = verb.vtyp ;
+ in {
+ s = {s = verb.s ; vtyp = typ} ;
+ agr = partAgr typ ;
+ neg = negation ;
+ clAcc = case isVRefl typ of {
+ True => CRefl ;
+ _ => CNone
+ } ;
+ clDat = CNone ; --- no dative refls
+ clit2 = [] ;
+ comp = \\a => [] ;
+ ext = \\p => []
+ } ;
+
+ insertObject : Compl -> Pronoun -> VP -> VP = \c,np,vp ->
+ let
+ vpacc = vp.clAcc ;
+ vpdat = vp.clDat ;
+ vpagr = vp.agr ;
+ npa = np.a ;
+ cpron = CPron npa.g npa.n npa.p ;
+ noNewClit = <vpacc, vpdat, appCompl c np.s, vpagr> ;
+
+ cc : CAgr * CAgr * Str * VPAgr = case <np.hasClit,c.isDir> of {
+ <True,True> => case c.c of {
+ Acc => <cpron, vpdat, [], vpAgrClit npa> ;
+ _ => <vpacc, cpron, [], vpagr> -- must be dat
+ } ;
+ _ => noNewClit
+ } ;
+
+ in {
+ s = vp.s ;
+ agr = cc.p4 ;
+ clAcc = cc.p1 ;
+ clDat = cc.p2 ;
+ clit2 = vp.clit2 ;
+ neg = vp.neg ;
+ comp = \\a => cc.p3 ++ vp.comp ! a ;
+ ext = vp.ext ;
+ } ;
+
+ insertComplement : (Agr => Str) -> VP -> VP = \co,vp -> {
+ s = vp.s ;
+ agr = vp.agr ;
+ clAcc = vp.clAcc ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ;
+ 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) ;
+ clAcc = vp.clAcc ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ;
+ neg = vp.neg ;
+ comp = vp.comp ;
+ ext = vp.ext ;
+ } ;
+
+ insertRefl : VP -> VP = \vp -> {
+ s = {s = vp.s.s ; vtyp = vRefl} ;
+ agr = vp.agr ;
+ clAcc = CRefl ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ;
+ neg = vp.neg ;
+ comp = vp.comp ;
+ ext = vp.ext ;
+ } ;
+
+ insertAdv : Str -> VP -> VP = \co,vp -> {
+ s = vp.s ;
+ agr = vp.agr ;
+ clAcc = vp.clAcc ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ;
+ neg = vp.neg ;
+ comp = \\a => vp.comp ! a ++ co ;
+ ext = vp.ext ;
+ } ;
+
+ insertAdV : Str -> VP -> VP = \co,vp -> {
+ s = vp.s ;
+ agr = vp.agr ;
+ clAcc = vp.clAcc ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ;
+ neg = \\b => let vpn = vp.neg ! b in {p1 = vpn.p1 ; p2 = vpn.p2 ++ co} ;
+ comp = vp.comp ;
+ ext = vp.ext ;
+ } ;
+
+ insertClit2 : Str -> VP -> VP = \co,vp -> {
+ s = vp.s ;
+ agr = vp.agr ;
+ clAcc = vp.clAcc ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ++ co ; ---- y en
+ neg = vp.neg ;
+ comp = vp.comp ;
+ ext = vp.ext ;
+ } ;
+
+ insertExtrapos : (Polarity => Str) -> VP -> VP = \co,vp -> {
+ s = vp.s ;
+ agr = vp.agr ;
+ clAcc = vp.clAcc ;
+ clDat = vp.clDat ;
+ clit2 = vp.clit2 ;
+ neg = vp.neg ;
+ comp = vp.comp ;
+ ext = \\p => vp.ext ! p ++ co ! p ;
+ } ;
+
+ mkVPSlash : Compl -> VP -> VP ** {c2 : Compl} = \c,vp -> vp ** {c2 = c} ;
+
+ mkClause : Str -> Bool -> Agr -> VP ->
+ {s : Direct => RTense => Anteriority => Polarity => Mood => Str} =
+ \subj,hasClit,agr,vpr -> {
+ s = \\d,t,a,b,m =>
+ let
+ tm = case t of {
+ RPast => VImperf m ; --# notpresent
+ RFut => VFut ; --# notpresent
+ RCond => VCondit ; --# notpresent
+ RPasse => VPasse ; --# notpresent
+ RPres => VPres m
+ } ;
+ vp = useVP vpr ;
+ vps = vp.s ! VPFinite tm a ;
+ verb = vps.fin ! agr ;
+ inf = vps.inf ! (appVPAgr vp.agr (aagr agr.g agr.n)) ; --- subtype bug
+ neg = vp.neg ! b ;
+ clpr = pronArg agr.n agr.p vp.clAcc vp.clDat ;
+ compl = clpr.p2 ++ vp.comp ! agr ++ vp.ext ! b
+ in
+ case d of {
+ DDir =>
+ subj ++ neg.p1 ++ clpr.p1 ++ vp.clit2 ++ verb ++ neg.p2 ++ inf ;
+ DInv =>
+ neg.p1 ++ clpr.p1 ++ vp.clit2 ++ verb ++
+ preOrPost hasClit subj (neg.p2 ++ inf)
+ }
+ ++ compl
+ } ;
+--- 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 = \vpr,agr ->
+ let
+ vp = useVP vpr ;
+ clpr = pronArg agr.n agr.p vp.clAcc vp.clDat ;
+ iform = infForm agr.n agr.p vp.clAcc vp.clDat ;
+ inf = (vp.s ! VPInfinit Simul iform).inf ! (aagr agr.g agr.n) ;
+ neg = vp.neg ! Pos ; --- Neg not in API
+ obj = neg.p2 ++ clpr.p2 ++ vp.comp ! agr ++ vp.ext ! Pos ---- pol
+ in
+ clitInf clpr.p3 (clpr.p1 ++ vp.clit2) inf ++ obj ;
+
+}
+
+-- 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