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.

lib/src/french/exper/ConstructionFre.gf

@@ -0,0 +1,148 @@
+--# -path=alltenses:.:../abstract
+
+concrete ConstructionFre of Construction = CatFre ** 
+  open SyntaxFre, SymbolicFre, ParadigmsFre, 
+       (L = LexiconFre), (E = ExtraFre), (I = IrregFre), (R = ResFre), (C = CommonRomance),
+       Prelude in {
+flags coding=utf8 ;
+
+
+lin
+  hungry_VP = E.ComplCN have_V2 (mkCN (mkN "faim")) ;
+  thirsty_VP = E.ComplCN have_V2 (mkCN (mkN "soif")) ;
+  has_age_VP card = mkVP have_V2 (mkNP <lin Card card : Card> L.year_N) ;
+
+  have_name_Cl x y = mkCl x (mkV2 (reflV (mkV "appeler"))) y ;
+----  married_Cl x y = mkCl (lin NP x) L.married_A2 (lin NP y) | mkCl (mkNP and_Conj (lin NP x) (lin NP y)) (mkA "marié") ;
+
+----  what_name_QCl x = mkQCl how_IAdv (mkCl (lin NP x) (reflV (mkV "appeler"))) ;
+----  how_old_QCl x = mkQCl (mkIP whichSg_IDet (mkN "âge" masculine)) (lin NP x) have_V2 ;
+  how_far_QCl x = mkQCl (mkIAdv dative (mkIP which_IDet (mkN "distance"))) x ;
+
+-- some more things
+  weather_adjCl ap = mkCl (mkVP (mkVA (mkV I.faire_V2)) (lin AP ap)) ;
+   
+  is_right_VP = E.ComplCN have_V2 (mkCN (mkN "raison")) ;
+  is_wrong_VP = E.ComplCN have_V2 (mkCN (mkN "tort")) ;
+
+  n_units_AP card cn a = mkAP (lin AdA (mkUtt (mkNP <lin Card card : Card> (lin CN cn)))) (lin A a) ;
+
+  bottle_of_CN np = mkCN (lin N2 (mkN2 (mkN "bouteille" feminine) part_Prep)) np ;
+  cup_of_CN    np = mkCN (lin N2 (mkN2 (mkN "tasse") part_Prep)) np ;
+  glass_of_CN  np = mkCN (lin N2 (mkN2 (mkN "verre") part_Prep)) np ;
+
+{-
+-- spatial deixis and motion verbs
+
+  where_go_QCl np = mkQCl where_IAdv (mkCl np (mkVP L.go_V)) ;
+  where_come_from_QCl np =  mkQCl (lin IAdv (ss "d'où")) (mkCl np (mkVP L.go_V)) ;
+  
+  go_here_VP = mkVP (mkVP L.go_V) here_Adv ;
+  come_here_VP = mkVP (mkVP L.come_V) here_Adv ;
+  come_from_here_VP = mkVP (mkVP L.come_V) (mkAdv "d'ici") ;
+
+  go_there_VP = mkVP (mkVP L.go_V)  there_Adv ;
+  come_there_VP = mkVP (mkVP L.come_V) there_Adv ;
+  come_from_there_VP = mkVP (mkVP L.come_V) (mkAdv "de là") ;
+-}  
+
+lincat
+  Weekday = N ;
+  Monthday = NP ;
+  Month = N ;
+  Year = NP ;
+oper
+  noPrep : Prep = mkPrep [] ;
+
+lin
+  weekdayPunctualAdv w = lin Adv {s = w.s ! C.Sg} ;         -- lundi
+  weekdayHabitualAdv w = SyntaxFre.mkAdv noPrep (mkNP the_Det w) ; -- le lundi
+  weekdayLastAdv w = SyntaxFre.mkAdv noPrep (mkNP the_Det (mkCN (mkA "dernier") w)) ; -- le lundi dernier
+  weekdayNextAdv w = SyntaxFre.mkAdv noPrep (mkNP the_Det (mkCN (mkA "prochain") w)) ; -- le lundi prochain
+
+  monthAdv m = lin Adv {s = "en" ++ m.s ! C.Sg} ;         -- en mai
+  yearAdv y = SyntaxFre.mkAdv (mkPrep "en") y ;
+  dayMonthAdv d m = ParadigmsFre.mkAdv ("le" ++ (d.s ! R.Nom).comp ++ m.s ! C.Sg) ; -- le 17 mai ---- le 1 mai should be le 1er mai
+  monthYearAdv m y = lin Adv {s = "en" ++ m.s ! C.Sg ++ (y.s ! R.Nom).comp} ;         -- en mai 2012
+  dayMonthYearAdv d m y = ParadigmsFre.mkAdv ("le" ++ (d.s ! R.Nom).comp ++ m.s ! C.Sg ++ (y.s ! R.Nom).comp) ; -- le 17 mai 2013
+
+  intYear = symb ;
+  intMonthday = symb ;
+  
+
+lincat Language = N ;
+
+lin InLanguage l = SyntaxFre.mkAdv (mkPrep "en") (mkNP l) ;
+
+lin
+  weekdayN w = w ;
+
+  weekdayPN w = mkPN w ;
+  monthPN m = mkPN m ;
+
+  languageCN l = mkCN l ;
+  languageNP l = mkNP the_Det l ;
+
+oper mkLanguage : Str -> N = \s -> mkN s ;
+
+----------------------------------------------
+---- lexicon of special names
+
+lin monday_Weekday = mkN "lundi" ;
+lin tuesday_Weekday = mkN "mardi" ;
+lin wednesday_Weekday = mkN "mercredi" ;
+lin thursday_Weekday = mkN "jeudi" ;
+lin friday_Weekday = mkN "vendredi" ;
+lin saturday_Weekday = mkN "samedi" ;
+lin sunday_Weekday = mkN "dimanche" masculine ;
+
+lin january_Month = mkN "janvier" ; 
+lin february_Month = mkN "février" ; 
+lin march_Month = mkN "mars" ; 
+lin april_Month = mkN "avril" ;
+lin may_Month = mkN "mai" ;
+lin june_Month = mkN "juin" ;
+lin july_Month = mkN "juillet" ;
+lin august_Month = mkN "août" ;
+lin september_Month = mkN "septembre" ;
+lin october_Month = mkN "octobre" ;
+lin november_Month = mkN "novembre" ;
+lin december_Month = mkN "décembre" ;
+
+lin afrikaans_Language = mkLanguage "afrikaans" ;
+lin amharic_Language = mkLanguage "amharique" ; ----
+lin arabic_Language = mkLanguage "arabe" ;
+lin bulgarian_Language = mkLanguage "bulgare" ;
+lin catalan_Language = mkLanguage "catalan" ;
+lin chinese_Language = mkLanguage "chinois" ;
+lin danish_Language = mkLanguage "danois" ;
+lin dutch_Language = mkLanguage "hollandais" ;
+lin english_Language = mkLanguage "anglais" ;
+lin estonian_Language = mkLanguage "estonien" ;
+lin finnish_Language = mkLanguage "finnois" ;
+lin french_Language = mkLanguage "français" ;
+lin german_Language = mkLanguage "allemand" ;
+lin greek_Language = mkLanguage "grècque" ;
+lin hebrew_Language = mkLanguage "hebreu" ;
+lin hindi_Language = mkLanguage "hindi" ;
+lin japanese_Language = mkLanguage "japonais" ;
+lin italian_Language = mkLanguage "italien" ;
+lin latin_Language = mkLanguage "latin" ;
+lin latvian_Language = mkLanguage "letton" ;
+lin maltese_Language = mkLanguage "maltais" ;
+lin nepali_Language = mkLanguage "nepali" ;
+lin norwegian_Language = mkLanguage "norvégien" ;
+lin persian_Language = mkLanguage "persien" ;
+lin polish_Language = mkLanguage "polonais" ;
+lin punjabi_Language = mkLanguage "punjabi" ;
+lin romanian_Language = mkLanguage "roumain" ;
+lin russian_Language = mkLanguage "russe" ;
+lin sindhi_Language = mkLanguage "sindhi" ;
+lin spanish_Language = mkLanguage "espagnol" ;
+lin swahili_Language = mkLanguage "swahili" ;
+lin swedish_Language = mkLanguage "suédois" ;
+lin thai_Language = mkLanguage "thaï" ;
+lin turkish_Language = mkLanguage "turque" ;
+lin urdu_Language = mkLanguage "urdu" ;
+
+}

lib/src/french/exper/ExtraFre.gf

@@ -0,0 +1,89 @@
+concrete ExtraFre of ExtraFreAbs = ExtraRomanceFre ** 
+  open CommonRomance, PhonoFre, MorphoFre, ParadigmsFre, ParamX, ResFre, Prelude in {
+
+  flags coding=utf8 ;
+  lin
+    EstcequeS qs          = {s = "est-ce" ++ elisQue ++ qs.s ! Indic} ;
+    EstcequeIAdvS idet qs = {s = idet.s ++ "est-ce" ++ elisQue ++ qs.s ! Indic} ;
+
+    QueestcequeIP = {
+      s = table {
+        c => prepQue c ++ "est-ce" ++ caseQue c
+        } ; 
+      a = aagr Fem Pl
+      } ;
+
+    QuiestcequeIP = {
+      s = table {
+        c => prepQue c ++ "qui" ++ "est-ce" ++ caseQue c
+        } ; 
+      a = aagr Fem Pl
+      } ;
+
+    i8fem_Pron = mkPronoun
+      (elision "j") (elision "m") (elision "m") "moi" "mon" (elisPoss "m") "mes"
+      Fem Sg P1 ;
+    these8fem_NP = makeNP ["celles-ci"] Fem Pl ;
+    they8fem_Pron = mkPronoun
+      "elles" "les" "leur" "eux" "leur" "leur" "leurs"
+      Fem Pl P3 ;
+    this8fem_NP = pn2np (mkPN ["celle-ci"] Fem) ;
+    those8fem_NP = makeNP ["celles-là"] Fem Pl ;
+    we8fem_Pron = mkPronoun "nous" "nous" "nous" "nous" "notre" "notre" "nos"
+      Fem Pl P1 ;
+    whoPl8fem_IP = 
+      {s = \\c => "les" + quelPron ! a ; a = a}
+      where {a = aagr Fem Pl} ;
+    whoSg8fem_IP = 
+      {s = \\c => "la" + quelPron ! a ; a = a}
+      where {a = aagr Fem Pl} ;
+
+    youSg8fem_Pron = mkPronoun 
+      "tu" (elision "t") (elision "t") "toi" "ton" (elisPoss "t") "tes"
+      Fem Sg P2 ;
+    youPl8fem_Pron =
+      let vous = mkPronoun "vous" "vous" "vous" "vous" "votre" "votre" "vos" Fem Pl P2
+      in 
+      {s = vous.s ; hasClit = vous.hasClit ; poss = vous.poss ; a = vous.a ; isPol = False ; isNeg = False} ;
+    youPol8fem_Pron =
+      let vous = mkPronoun "vous" "vous" "vous" "vous" "votre" "votre" "vos" Fem Pl P2
+      in 
+      {s = vous.s ; hasClit = vous.hasClit ; poss = vous.poss ; a = vous.a ; isPol = True ; isNeg = False} ;
+
+    ce_Pron = 
+      let ce = elision "c" 
+      in 
+      mkPronoun ce ce ce ("cela" | "ça") "son" (elisPoss "s") "ses" Masc Sg P3 ; ---- variants?
+
+    AdvDatVP = insertClit3 datClit ;
+    AdvGenVP = insertClit3 genClit ;
+
+  oper
+    prepQue : Case -> Str = \c -> case c of {
+      Nom | Acc => elisQue ;
+      _   => prepCase c ++ "qui" ---
+      } ;
+    caseQue : Case -> Str = \c -> case c of {
+      Nom => "qui" ;
+      _   => elisQue
+      } ;
+
+  lin
+    tout_Det = {
+    s  = \\g,c => prepCase c ++ genForms "tout" "toute" ! g ;
+    sp = \\g,c => prepCase c ++ genForms "tout" "toute" ! g ;
+    n = Sg ; 
+    s2 = [] ;
+    isNeg = False
+    } ;
+
+    PNegNe = {s = [] ; p = RNeg True} ;
+
+    ExistsNP np = 
+      mknpClause "il" (insertComplement (\\_ => (np.s ! Nom).ton) (predV (regV "exister"))) ; ---- np.a
+
+--- in ExtraRomance
+--    PassAgentVPSlash vps np = passVPSlash 
+--      vps ("par" ++ (np.s ! Acc).ton) ;
+
+}

lib/src/french/exper/IdiomFre.gf

@@ -0,0 +1,67 @@
+concrete IdiomFre of Idiom = CatFre ** 
+  open (P = ParamX), PhonoFre, MorphoFre, ParadigmsFre, Prelude in {
+
+  flags optimize=all_subs ;
+  flags coding=utf8 ;
+
+  lin
+    ImpersCl vp = mknpClause "il" vp ;
+    GenericCl vp = mknpClause "on"  vp ;
+
+    ExistNP np = 
+      mknpClause "il" 
+        (insertClit3 "y" (insertComplement (\\_ => (np.s ! Acc).ton) (predV avoir_V))) ;
+
+    ExistIP ip = 
+      mknpClause "il" 
+        (insertClit3 "y" (predV avoir_V)) ** {ip = ip.s ! Nom ; isSent = False} ;
+
+    CleftNP np rs = mknpClause elisCe   ---- True np.isPol (agrP3 Masc Sg) 
+      (insertComplement (\\_ => rs.s ! Indic ! np.a)
+        (insertComplement (\\_ => (np.s ! rs.c).ton) (predV copula))) ;
+
+    CleftAdv ad s = mknpClause elisCe 
+      (insertComplement (\\_ => conjThat ++ s.s ! Indic)
+        (insertComplement (\\_ => ad.s) (predV copula))) ;
+
+
+    ProgrVP vp = 
+      insertComplement 
+        (\\a => "en" ++ "train" ++ elisDe ++ infVP vp a) 
+        (predV copula) ;
+
+    ImpPl1 vp = {
+      s = mkImperative False P1 vp ! RPos ! Masc ! Pl  --- fem
+      } ;
+
+    ImpP3 np vp = {
+      s = (mkClause (np.s ! Nom).comp np.hasClit False np.a vp).s 
+             ! DInv ! RPres ! Simul ! RPos ! Conjunct
+      } ;
+
+
+    SelfAdvVP vp = insertComplement memePron vp ;
+    SelfAdVVP vp = insertComplement memePron vp ; ---- should be AdV
+    SelfNP np = heavyNP {
+      s = \\c => (np.s ! c).ton ++ memePron ! np.a ; ---- moi moi-même ? 
+      a = np.a
+      } ;
+
+  oper
+    elisCe = elision "c" ;
+
+    memePron : Agr => Str = table {
+      {n = Sg ; p = P1} => "moi-même" ;
+      {n = Sg ; p = P2} => "toi-même" ;
+      {g = Masc ; n = Sg ; p = P3} => "lui-même" ;
+      {g = Fem  ; n = Sg ; p = P3} => "elle-même" ;
+      {n = Pl ; p = P1} => "nous-mêmes" ;
+      {n = Pl ; p = P2} => "vous-mêmes" ;
+      {g = Masc ; n = Pl ; p = P3} => "eux-mêmes" ;
+      {g = Fem  ; n = Pl ; p = P3} => "elles-mêmes"
+      } ;
+
+
+}
+
+

lib/src/french/exper/TranslateFre.gf

@@ -0,0 +1,75 @@
+--# -path=.:../chunk:alltenses
+
+concrete TranslateFre of Translate = 
+  TenseFre,
+  NounFre - [PPartNP],
+  AdjectiveFre,
+  NumeralFre,
+  SymbolFre [
+    PN, Symb, String, CN, Card, NP, MkSymb, SymbPN, CNNumNP
+    ],
+  ConjunctionFre,
+  VerbFre -  [
+    UseCopula,  
+    PassV2  -- generalized in Extensions
+    ],
+  AdverbFre,
+  PhraseFre,
+  SentenceFre,
+  QuestionFre ---- - [
+----    QuestCl,QuestIAdv -- french-specific overrides
+----    ]
+  ,
+  RelativeFre,
+  IdiomFre,
+  ConstructionFre,
+  DocumentationFre,
+
+  ChunkFre,
+  ExtensionsFre [
+    CompoundN,AdAdV,UttAdV,ApposNP,MkVPI, MkVPS, PredVPS, PassVPSlash, PassAgentVPSlash, CompoundAP
+    , PastPartAP, PastPartAgentAP, PresPartAP, GerundNP, GerundAdv
+    , WithoutVP, InOrderToVP, ByVP
+    ],
+
+  DictionaryFre ** 
+open PhonoFre, MorphoFre, ResFre, CommonRomance, ParadigmsFre, SyntaxFre, Prelude, (G = GrammarFre) in {
+
+flags
+  literal=Symb ;
+  coding = utf8 ;
+
+-- overrides from Lang
+{- -----
+lin
+  QuestCl cl = 
+    {s = \\t,a,p =>                             -- est-ce qu'il dort ?
+            let cls = cl.s ! DDir ! t ! a ! p 
+            in table {
+              QDir   => "est-ce" ++ elisQue ++ cls ! Indic ;
+              QIndir => subjIf ++ cls ! Indic
+              }
+      }
+  | {s = \\t,a,p =>                             -- dort-il ?
+            let cls = cl.s ! DInv ! t ! a ! p 
+            in table {
+              QDir   => cls ! Indic ;
+              QIndir => subjIf ++ cls ! Indic
+              }
+      }
+  | G.QuestCl cl                                -- il dort ?
+  ;
+
+
+  QuestIAdv iadv cl = 
+     G.QuestIAdv iadv cl                       -- où dort-il
+   | {s = \\t,a,p,q =>                         -- où est-ce qu'il dort        
+            let 
+              ord = DDir ;
+              cls = cl.s ! ord ! t ! a ! p ! Indic ;
+              why = iadv.s
+            in why ++ "est-ce" ++ elisQue ++ cls
+      } ;
+-}
+
+}

lib/src/romance/exper/CatRomance.gf

@@ -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 ;
+
+}

lib/src/romance/exper/QuestionRomance.gf

@@ -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
+-}
+
+}
+

lib/src/romance/exper/RelativeRomance.gf

@@ -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
+      } ;
+
+}

lib/src/romance/exper/ResRomance.gf

@@ -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

lib/src/romance/exper/SentenceRomance.gf

@@ -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
+      } ;
+
+}