French Swadesh, some bugs remain

resource/french/BasicFre.gf

@@ -15,13 +15,13 @@ lin
   art_N = regN "art" feminine ;
   ask_V2Q = mkV2Q (regV "demander") dative ;
   baby_N = regN "bébé" masculine ;
-  bad_ADeg = mkADeg (regA "mauvaise") (regA "pire") ;
+  bad_ADeg = prefADeg (mkADeg (regA "mauvais") (regA "pire")) ;
   bank_N = regN "banque" feminine ;
-  beautiful_ADeg = regADeg "joli" ; ---- beau
+  beautiful_ADeg = prefADeg (regADeg "joli") ; ---- beau
   become_VA = mkVA devenir_V ;
   beer_N = regN "bière" feminine ;
   beg_V2V = mkV2V (regV "demander") accusative dative ;
-  big_ADeg = regADeg "grand" ;
+  big_ADeg = prefADeg (regADeg "grand") ;
   bike_N = regN "vélo" masculine ;
   bird_N = regN "oiseau" masculine ;
   black_ADeg = regADeg "noir" ;
@@ -83,8 +83,8 @@ lin
   girl_N = regN "fille" feminine ;
   glove_N = regN "gant" masculine ;
   gold_N = regN "or" masculine ;
-  good_ADeg = mkADeg (mkA "bon" "bonne" "bons" "bien") 
+  good_ADeg = prefADeg (mkADeg (mkA "bon" "bonne" "bons" "bien") 
-    (mkA "meilleur" "meilleure" "meilleurs" "mieux") ;
+    (mkA "meilleur" "meilleure" "meilleurs" "mieux")) ;
   go_V = aller_V ;
   green_ADeg = regADeg "vert" ;
   harbour_N = regN "port" masculine ;
@@ -123,10 +123,11 @@ lin
   mountain_N = regN "montagne" feminine ;
   music_N = regN "musique" feminine ;
   narrow_ADeg = regADeg "étroit" ;
-  new_ADeg = compADeg (mkA "nouveau" "nouvelle" "nouveaux" "nouvellement") ;
+  new_ADeg = prefADeg (compADeg (mkA "nouveau" "nouvelle" "nouveaux" "nouvellement")) ;
   newspaper_N = regN "journal" masculine ;
   oil_N = regN "huile" feminine ;
-  old_ADeg = compADeg (mkA "vieux" "vieille" "vieux" "vieillement") ; ---- vieil
+  old_ADeg = 
+    prefADeg (compADeg (mkA "vieux" "vieille" "vieux" "vieillement")) ; ---- vieil
   open_V2 = ouvrir_V2 ;
   paint_V2A = mkV2A (v2V peindre_V2) accusative ;
   paper_N = regN "papier" masculine ;
@@ -167,7 +168,7 @@ lin
   silver_N = regN "argent" masculine ;
   sister_N = regN "soeur" feminine ;
   sleep_V = v2V dormir_V2 ;
-  small_ADeg = regADeg "petit" ;
+  small_ADeg = prefADeg (regADeg "petit") ;
   snake_N = regN "serpent" masculine ;
   sock_N = regN "chaussette" feminine ;
   speak_V2 = dirV2 (regV "parler") ;
@@ -201,7 +202,7 @@ lin
   war_N = regN "guerre" masculine ;
   watch_V2 = dirV2 (regV "regarder") ;
   water_N = regN "eau" feminine ;
-  white_ADeg = compADeg (mkA "blanc" "blance" "blancs" "blanchement") ;
+  white_ADeg = compADeg (mkA "blanc" "blanche" "blancs" "blanchement") ;
   window_N = regN "fenêtre" feminine ;
   wine_N = regN "vin" masculine ;
   win_V2 = dirV2 (regV "gagner") ; ---- vaincre
@@ -210,7 +211,7 @@ lin
   wood_N = regN "bois" masculine ;
   write_V2 = écrire_V2 ;
   yellow_ADeg = regADeg "jaune" ;
-  young_ADeg = regADeg "jeune" ;
+  young_ADeg = prefADeg (regADeg "jeune") ;
 
   do_V2 = faire_V2 ;
   now_Adv = mkAdv "maintenant" ;

resource/french/MorphoFre.gf

@@ -106,8 +106,11 @@ oper
 -- Then the regular and invariant patterns.
 
   adjReg : Str -> Gender => Number => Str = \bu -> table {
-    Masc => nomReg bu ;
+    Masc => (mkNomReg bu Masc).s ;
-    Fem  => nomReg (bu + "e")
+    Fem  => nomReg (case last bu of {
+      "e" => bu ;
+      _ => bu + "e"
+      })
     } ;
 
   adjInvar : Str -> Gender => Number => Str = \bien -> 
@@ -116,7 +119,12 @@ oper
 -- Adjectives themselves are records. Here the most common cases:
 
   adjGrand : Str -> Adj = \grand -> 
-    mkAdj grand (grand + "s") (grand + "e") (grand + "ement") ;
+    let grande = case last grand of {
+      "e" => grand ;
+      _ => grand + "e"
+      }
+    in
+    mkAdj grand (grand + "s") grande (grande + "ment") ;
 
 -- Masculine form used for adverbial; also covers "carré".
 
@@ -154,6 +162,7 @@ oper
         "er" => adjCher creux ;
         _ => case Predef.dp 1 creux of {
           "s" => adjFrancais creux ;
+          "x" => adjFrancais creux ;
           "e" => adjJeune creux ;
           "é" => adjJoli creux ;
           "i" => adjJoli creux ;

resource/french/ParadigmsFre.gf

@@ -170,6 +170,10 @@ oper
 
   adegA : ADeg -> A ;
 
+-- For prefixed adjectives, the following function is
+-- provided.
+
+  prefADeg : ADeg -> ADeg ;
 
 --2 Adverbs
 
@@ -284,7 +288,7 @@ oper
   mkNP x g n = let np = mkNameNounPhrase x g in
     {s = np.s ; g = np.g ; p = np.p ; c = np.c ; n = n ; lock_NP = <>} ;
 
-  mkA a b c d = mkAdj a b c d ** {p = False ; lock_A = <>} ;
+  mkA a b c d = mkAdj a c b d ** {p = False ; lock_A = <>} ;
   regA a = mkAdjReg a False ** {p = False ; lock_A = <>} ;
   prefA a = {s = a.s ; p = True ; lock_A = <>} ;
 
@@ -294,6 +298,7 @@ oper
   compADeg a = {s = table {Pos => a.s ; _ => \\f => "plus" ++ a.s ! f} ; p = a.p ;
                lock_ADeg = <>} ;
   regADeg a = compADeg (regA a) ;
+  prefADeg a = {s = a.s ; p = True ; lock_ADeg = <>} ;
 
   adegA a = {s = a.s ! Pos ; p = a.p ; lock_A = <>} ;
 

resource/french/SwadeshLexFre.gf

@@ -0,0 +1,246 @@
+--# -path=.:../abstract:../../prelude:../romance
+
+concrete SwadeshLexFre of SwadeshLex = CategoriesFre 
+  ** open StructuralFre, RulesFre, SyntaxFre, ParadigmsFre, VerbsFre, 
+          BasicFre, Prelude in {
+
+  lin
+
+    -- Pronouns
+
+    i_NP = i_NP ;
+    thou_NP = thou_NP ;
+    he_NP = he_NP ;
+    we_NP = we_NP ;
+    you_NP = you_NP ;
+    they_NP = they_NP ;
+    who8many_IP = who8many_IP ;
+    who8one_IP = who8one_IP ;
+    what8many_IP = what8many_IP ;
+    what8one_IP = what8one_IP ;
+
+    -- Determiners
+
+    this_Det = this_Det ;
+    that_Det = that_Det ;
+    all_NDet = all_NDet ;
+    many_Det = many_Det ;
+    some_Det = some_Det ;
+    few_Det = mkDeterminer1 Pl ("peu" ++ elisDe) ;
+    other_Det = mkDeterminer1 Pl ["d'autres"] ;
+
+
+    -- Adverbs
+
+    here_Adv = here_Adv;
+    there_Adv = there_Adv;
+    where_IAdv = where_IAdv;
+    when_IAdv = when_IAdv;
+    how_IAdv = how_IAdv;
+
+    -- not : Adv ; -- ?
+
+    -- Conjunctions
+
+    and_Conj = and_Conj ;
+
+    -- Prepositions
+
+    at_Prep = justCase dative.p1 ;
+    in_Prep = StructuralFre.in_Prep ;
+    with_Prep = StructuralFre.with_Prep ;
+
+    -- Numerals
+
+    one_Num = UseNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01)))) ;
+    two_Num = UseNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n2))))) ;
+    three_Num = UseNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n3))))) ;
+    four_Num = UseNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n4))))) ;
+    five_Num = UseNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))) ;
+
+    -- Adjectives
+
+    bad_ADeg = bad_ADeg ;
+    big_ADeg = big_ADeg ;
+    black_ADeg = black_ADeg ;
+    cold_ADeg = cold_ADeg ;
+    correct_ADeg = regADeg "correct" ;
+    dirty_ADeg = dirty_ADeg ;
+    dry_ADeg = compADeg (mkA "sec" "sèche" "secs" "sèches") ;
+    dull_ADeg = regADeg "émoussé" ;
+    far_ADeg = regADeg "lointain" ;
+    full_ADeg = regADeg "plein" ;
+    good_ADeg = good_ADeg ;
+    green_ADeg = green_ADeg ;
+    heavy_ADeg = regADeg "lourd" ;
+    long_ADeg = long_ADeg ;
+    narrow_ADeg = narrow_ADeg ;
+    near_ADeg = regADeg "proche" ;
+    new_ADeg = new_ADeg ;
+    old_ADeg = old_ADeg ;
+    red_ADeg = red_ADeg ;
+    rotten_ADeg = regADeg "pourri" ;
+    round_ADeg = regADeg "rond" ;
+    sharp_ADeg = regADeg "tranchant" ;
+    short_ADeg = short_ADeg ;
+    small_ADeg = small_ADeg ;
+    smooth_ADeg = regADeg "lisse" ;
+    straight_ADeg = regADeg "droite" ;
+    thick_ADeg = thick_ADeg ;
+    thin_ADeg = thin_ADeg ;
+    warm_ADeg = warm_ADeg ;
+    wet_ADeg = regADeg "mouillé" ;
+    white_ADeg = white_ADeg ;
+    wide_ADeg = regADeg "large" ;
+    yellow_ADeg = yellow_ADeg ;
+
+    left_A = regA "gauche" ;
+    right_A = regA "droite" ;
+
+    -- Nouns
+
+    animal_N = regN "animal" masculine ;
+    ashes_N = regN "cendre" masculine ;
+    back_N = regN "dos" masculine ;
+    bark_N = regN "écorce" feminine ; 
+    belly_N = regN "ventre" masculine ;
+    bird_N = bird_N;
+    blood_N = regN "sang" masculine ;
+    bone_N = regN "os" masculine ;
+    breast_N = regN "sein" masculine ; --- poitrine
+    child_N = child_N ;
+    cloud_N = regN "nuage" masculine ;
+    day_N = regN "jour" masculine ;
+    dog_N = dog_N ;
+    dust_N = regN "poussière" feminine ;
+    ear_N = regN "oreille"  feminine ;
+    earth_N = regN "terre" feminine ;
+    egg_N = regN "oeuf" masculine ;
+    eye_N = mkN "oeil" "yeux" masculine ;
+    fat_N = regN "graisse" feminine ;
+    father_N = UseN2 father_N2 ;
+    feather_N = regN "plume" feminine ;
+    fingernail_N = regN "ongle" masculine ;
+    fire_N = regN "feu" masculine ;
+    fish_N = fish_N ;
+    flower_N = regN "fleur" feminine ;
+    fog_N = regN "brouillard" masculine ;
+    foot_N = regN "pied" masculine ;
+    forest_N = regN "forêt" feminine ;
+    fruit_N = fruit_N ;
+    grass_N = regN "herbe" feminine ;
+    guts_N = regN "entraille" feminine ;
+    hair_N = regN "cheveu" masculine ;
+    hand_N = regN "main" masculine ;
+    head_N = regN "tête" feminine ;
+    heart_N = regN "coeur" masculine ;
+    horn_N = regN "corne" masculine ;
+    husband_N = regN "mari" masculine ;
+    ice_N = regN "glace" feminine ;
+    knee_N = regN "genou" masculine ;
+    lake_N = lake_N ;
+    leaf_N = regN "feuille" feminine ;
+    leg_N = regN "jambe" feminine ;
+    liver_N = regN "foie" masculine ;
+    louse_N = regN "pou" masculine ;
+    man_N = man_N ;
+    meat_N = meat_N ;
+    moon_N = moon_N ;
+    mother_N = UseN2 mother_N2 ;
+    mountain_N = mountain_N ;
+    mouth_N = regN "bouche" masculine ;
+    name_N = regN "nom" masculine ;
+    neck_N = mkN "cou" "cous" masculine ;
+    night_N = regN "nuit" feminine ;
+    nose_N = regN "nez" masculine ;
+    person_N = regN "personne" feminine ;
+    rain_N = regN "pluie" feminine ;
+    river_N = river_N ;
+    road_N = regN "route" feminine ;
+    root_N = regN "racine" feminine ;
+    rope_N = regN "corde" feminine ;
+    salt_N = regN "sel" masculine ;
+    sand_N = regN "sable" masculine ;
+    sea_N = sea_N ;
+    seed_N = regN "graine" masculine ;
+    skin_N = regN "peau" masculine ;
+    sky_N = mkN "ciel" "cieux" masculine ; 
+    smoke_N = regN "fumée" feminine ;
+    snake_N = snake_N ;
+    snow_N = regN "neige" feminine ;
+    star_N = star_N ;
+    stick_N = regN "bâton" masculine ;
+    stone_N = stone_N ;
+    sun_N = sun_N ;
+    tail_N = regN "queue" feminine ;
+    tongue_N = regN "langue" feminine ;
+    tooth_N = regN "dent" feminine ;
+    tree_N = tree_N ;
+    water_N = water_N ;
+    wife_N = regN "femme" feminine ;
+    wind_N = regN "vent" masculine ;
+    wing_N = regN "aile" feminine ;
+    woman_N = woman_N ;
+    worm_N = regN "ver" masculine ; 
+    year_N = regN "an" masculine ; --- année
+
+    -- Verbs
+
+    bite_V = UseV2 mordre_V2 ;
+    blow_V = regV "souffler" ;
+    breathe_V = regV "respirer" ;
+    burn_V = regV "brûler" ;
+    come_V = venir_V ;
+    count_V = regV "conter" ;
+    cut_V = regV "tailler" ;
+    die_V = mourir_V ;
+    dig_V = regV "creuser" ;
+    drink_V = UseV2 boire_V2 ;
+    eat_V = regV "manger" ;
+    fall_V = regV "tomber" ;
+    fear_V = UseV2 craindre_V2 ;
+    fight_V = regV "lutter" ;
+    float_V = regV "flotter" ;
+    flow_V = regV "couler" ;
+    fly_V = regV "voler" ;
+    freeze_V = regV "geler" ; ---- check conjugation
+    give_V = regV "donner" ;
+    hear_V = UseV2 entendre_V2 ;
+    hit_V = regV "frapper" ;
+    hold_V = UseV2 tenir_V2 ;
+    hunt_V = regV "chasser" ;
+    kill_V = regV "tuer" ;
+    know_V = UseV2 savoir_V2 ; --- connaître
+    laugh_V = UseV2 rire_V2 ;
+    lie_V = UseV2 étendre_V2 ; ---- reflexive
+    live_V = UseV2 vivre_V2 ;
+    play_V = regV "jouer" ;
+    pull_V = regV "tirer" ;
+    push_V = regV "pousser" ;
+    rub_V = regV "frotter" ;
+    say_V = UseV2 dire_V2 ;
+    scratch_V = regV "gratter" ;
+    see_V = UseV2 voir_V2 ;
+    sew_V = regV "semer"; ---- conjug
+    sing_V = regV "chanter" ;
+    sit_V = UseV2 asseoir_V2 ; --- refl
+    sleep_V = UseV2 dormir_V2 ;
+    smell_V = UseV2 sentir_V2 ;
+    spit_V = regV "cracher" ;
+    split_V = UseV2 fendre_V2 ;
+    squeeze_V = regV "squeeze" ;
+    stab_V = regV "serrer" ;
+    stand_V = regV "lever" ; ---- refl ----
+    suck_V = regV "sucer" ;
+    swell_V = regV "gonfler" ;
+    swim_V = regV "nager" ;
+    think_V = regV "penser" ;
+    throw_V = regV "jeter" ;
+    tie_V = regV "lier" ;
+    turn_V = regV "tourner" ;
+    vomit_V = regV "vomir" ;
+    walk_V = regV "marcher" ;
+    wash_V = regV "laver" ;
+    wipe_V = regV "essuyer" ;
+
+}

resource/romance/RulesRomance.gf

@@ -85,7 +85,7 @@ lin
 -- Adverbs.
 
   AdjAdv a = {s = a.s ! AA} ;
-  AdvVP = adVerbPhrase ;
+----  AdvVP = adVerbPhrase ;
   AdvPP p = p ;
 
   PrepNP = prepNounPhrase ;

resource/romance/SyntaxRomance.gf

@@ -1411,4 +1411,125 @@ oper
   siSubj, quandSubj : Subjunction ;
 
   ouiPhr, noPhr : Utterance ;
+
+---------------------------------------------------------------------
+---- for Sats; to be moved earlier
+
+  Sats : Type = {
+      s1 : Str ;        -- je                 je
+      s3 : Str ;        -- (ne) le lui        (ne)     
+      s4 : VF => Str ;  -- ai                 ai
+      s5 : Str ;        -- toujours (pas)     toujours (pas)
+      s6 : Str ;        -- (dit) directement  (voulu) le lui dire directement
+      aux : VAux ;
+      g,g2 : Gender ;   -- features for main verb and participle
+      n,n2 : Number ;
+      p : Person        -- feature of subject
+      
+      } ;
+
+  verbClForm : 
+    Verb -> ClForm -> Gender -> Number -> Person -> Gender -> Number -> (Str * Str) = 
+    \verb,cl,g,n,p,g2,n2 -> 
+      let 
+        aimee = verb.s ! VPart g2 n2 ;
+        auxv  = (auxVerb verb).s ;
+        aime  : TMode -> Str = \t -> verb.s ! (VFin t n p) ;
+        avoir : TMode -> Str = \t -> auxv ! (VFin t n p) ;
+        aimer = verb.s ! VInfin ;
+        avoirr = auxv ! VInfin
+      in
+      case cl of {
+        ClPres   Simul m => <aime  (VPres m),   []> ;
+        ClPres   a m     => <avoir (VPres m),   aimee> ;
+        ClImperf Simul m => <aime  (VImperf m), []> ;
+        ClImperf a m     => <avoir (VImperf m), aimee> ;
+        ClPasse  Simul   => <aime  VPasse,      []> ;
+        ClPasse  a       => <avoir VPasse,      aimee> ;
+        ClFut    Simul   => <aime  VFut,        []> ;
+        ClFut    a       => <avoir VFut,        aimee> ;
+        ClCondit Simul   => <aime  VCondit,     []> ;
+        ClCondit a       => <avoir VCondit,     aimee> ;
+        ClInfinit Simul  => <aimer,             []> ;
+        ClInfinit a      => <avoirr,            aimee>
+        } ;
+
+  mkSats : NounPhrase -> Verb -> Sats = \subj,verb ->
+     let ifEsse : (T : Type) -> T -> T -> T = \T,e,h ->
+       case verb.aux of {
+         AEsse   => e ;
+         AHabere => h
+         }
+     in
+     {s1 = subj.s ! unstressed nominative ;
+      s3 = [] ;
+      s4 = verb.s ;
+      s5, s6 = [] ;
+      aux = verb.aux ;
+      g = pgen2gen subj.g ;
+      n = subj.n ;
+      p = subj.p ;
+      g2 = ifEsse Gender (pgen2gen subj.g) Masc ;
+      n2 = ifEsse Number subj.n            Sg
+      } ;
+
+  insertObject : Sats -> CaseA -> Str -> NounPhrase -> Sats = \sats, c, prep, obj -> 
+     let
+       ifClit : (T : Type) -> T -> T -> T = 
+         \T -> if_then_else T (andB (isNounPhraseClit obj) (isClitCase c)) ;
+       object = obj.s ! (case2pformClit c) ;
+       clit   = ifClit Str object [] ;
+       np     = ifClit Str [] object
+     in
+     {s1  = sats.s1 ;
+      s3  = sats.s3 ++ clit ; ---- or clit ++ s3, dep. on clits
+      s4  = sats.s4 ;
+      s5  = sats.s5 ;
+      s6  = sats.s6 ++ prep ++ np ;
+      aux = sats.aux ;
+      g   = sats.g ;
+      n   = sats.n ;
+      g2  = ifClit Gender (pgen2gen obj.g) sats.g2 ; ---- only for clit acc
+      n2  = ifClit Number obj.n sats.n2 ;
+      p   = sats.p
+      } ;
+
+  insertExtrapos : Sats -> Str -> Sats = \sats,obj -> 
+     {s1  = sats.s1 ;
+      s3  = sats.s3 ;
+      s4  = sats.s4 ;
+      s5  = sats.s5 ;
+      s6  = sats.s6 ++ obj ;
+      aux = sats.aux ;
+      g   = sats.g ;
+      n   = sats.n ;
+      g2  = sats.g2 ;
+      n2  = sats.n2 ;
+      p   = sats.p
+      } ;
+
+  mkSatsObject : NounPhrase -> TransVerb -> NounPhrase -> Sats = \subj,verb,obj ->
+    insertObject (mkSats subj verb) verb.c verb.s2 obj ;
+
+  mkSatsCopula : NounPhrase -> Str -> Sats = \subj,obj ->
+    mkSatsObject subj 
+      (mkTransVerbDir copula)                         --- hack to reuse  
+      (nameNounPhrase (mkProperName obj Masc)) ;      --- this function
+
+  sats2clause : Sats -> Clause = 
+    \sats -> {s = \\b,cf =>
+      let
+        je   = sats.s1 ;
+        lui  = sats.s3 ;
+        dire = verbClForm {s = sats.s4 ; aux = sats.aux}
+                 cf sats.g sats.n sats.p sats.g2 sats.n2 ;
+        ai   = dire.p1 ;
+        dit  = dire.p2 ;
+        toujours = sats.s5 ;
+        directement = sats.s6
+      in 
+      je ++ lui ++ ai ++ toujours ++ dit ++ directement
+    } ;
+
+
 }