xapian-core/languages/french.sbl

   1 // Alias: fr
   2
   3 routines (
   4            prelude postlude mark_regions
   5            RV R1 R2
   6            standard_suffix
   7            i_verb_suffix
   8            verb_suffix
   9            residual_suffix
  10            un_double
  11            un_accent
  12 )
  13
  14 externals ( stem )
  15
  16 integers ( pV p1 p2 )
  17
  18 groupings ( v keep_with_s )
  19
  20 stringescapes {}
  21
  22 /* special characters (in ISO Latin I) */
  23
  24 stringdef a^   hex 'E2'  // a-circumflex
  25 stringdef a`   hex 'E0'  // a-grave
  26 stringdef c,   hex 'E7'  // c-cedilla
  27
  28 stringdef e"   hex 'EB'  // e-diaeresis (rare)
  29 stringdef e'   hex 'E9'  // e-acute
  30 stringdef e^   hex 'EA'  // e-circumflex
  31 stringdef e`   hex 'E8'  // e-grave
  32 stringdef i"   hex 'EF'  // i-diaeresis
  33 stringdef i^   hex 'EE'  // i-circumflex
  34 stringdef o^   hex 'F4'  // o-circumflex
  35 stringdef u^   hex 'FB'  // u-circumflex
  36 stringdef u`   hex 'F9'  // u-grave
  37
  38 define v 'aeiouy{a^}{a`}{e"}{e'}{e^}{e`}{i"}{i^}{o^}{u^}{u`}'
  39
  40 define prelude as repeat goto (
  41
  42     (  v [ ('u' ] v <- 'U') or
  43            ('i' ] v <- 'I') or
  44            ('y' ] <- 'Y')
  45     )
  46     or
  47     (  ['y'] v <- 'Y' )
  48     or
  49     (  'q' ['u'] <- 'U' )
  50 )
  51
  52 define mark_regions as (
  53
  54     $pV = limit
  55     $p1 = limit
  56     $p2 = limit  // defaults
  57
  58     do (
  59         ( v v next )
  60         or
  61         among ( // this exception list begun Nov 2006
  62             'par'  // paris, parie, pari
  63             'col'  // colis
  64             'tap'  // tapis
  65             // extensions possible here
  66         )
  67         or
  68         ( next gopast v )
  69         setmark pV
  70     )
  71     do (
  72         gopast v gopast non-v setmark p1
  73         gopast v gopast non-v setmark p2
  74     )
  75 )
  76
  77 define postlude as repeat (
  78
  79     [substring] among(
  80         'I' (<- 'i')
  81         'U' (<- 'u')
  82         'Y' (<- 'y')
  83         ''  (next)
  84     )
  85 )
  86
  87 backwardmode (
  88
  89     define RV as $pV <= cursor
  90     define R1 as $p1 <= cursor
  91     define R2 as $p2 <= cursor
  92
  93     define standard_suffix as (
  94         [substring] among(
  95
  96             'ance' 'iqUe' 'isme' 'able' 'iste' 'eux'
  97             'ances' 'iqUes' 'ismes' 'ables' 'istes'
  98                ( R2 delete )
  99             'atrice' 'ateur' 'ation'
 100             'atrices' 'ateurs' 'ations'
 101                ( R2 delete
 102                  try ( ['ic'] (R2 delete) or <-'iqU' )
 103                )
 104             'logie'
 105             'logies'
 106                ( R2 <- 'log' )
 107             'usion' 'ution'
 108             'usions' 'utions'
 109                ( R2 <- 'u' )
 110             'ence'
 111             'ences'
 112                ( R2 <- 'ent' )
 113             'ement'
 114             'ements'
 115             (
 116                 RV delete
 117                 try (
 118                     [substring] among(
 119                         'iv'   (R2 delete ['at'] R2 delete)
 120                         'eus'  ((R2 delete) or (R1<-'eux'))
 121                         'abl' 'iqU'
 122                                (R2 delete)
 123                         'i{e`}r' 'I{e`}r'      //)
 124                                (RV <-'i')      //)--new 2 Sept 02
 125                     )
 126                 )
 127             )
 128             'it{e'}'
 129             'it{e'}s'
 130             (
 131                 R2 delete
 132                 try (
 133                     [substring] among(
 134                         'abil' ((R2 delete) or <-'abl')
 135                         'ic'   ((R2 delete) or <-'iqU')
 136                         'iv'   (R2 delete)
 137                     )
 138                 )
 139             )
 140             'if' 'ive'
 141             'ifs' 'ives'
 142             (
 143                 R2 delete
 144                 try ( ['at'] R2 delete ['ic'] (R2 delete) or <-'iqU' )
 145             )
 146             'eaux' (<- 'eau')
 147             'aux'  (R1 <- 'al')
 148             'euse'
 149             'euses'((R2 delete) or (R1<-'eux'))
 150
 151             'issement'
 152             'issements'(R1 non-v delete) // verbal
 153
 154             // fail(...) below forces entry to verb_suffix. -ment typically
 155             // follows the p.p., e.g 'confus{e'}ment'.
 156
 157             'amment'   (RV fail(<- 'ant'))
 158             'emment'   (RV fail(<- 'ent'))
 159             'ment'
 160             'ments'    (test(v RV) fail(delete))
 161                        // v is e,i,u,{e'},I or U
 162         )
 163     )
 164
 165     define i_verb_suffix as setlimit tomark pV for (
 166         [substring] among (
 167             '{i^}mes' '{i^}t' '{i^}tes' 'i' 'ie' 'ies' 'ir' 'ira' 'irai'
 168             'iraIent' 'irais' 'irait' 'iras' 'irent' 'irez' 'iriez'
 169             'irions' 'irons' 'iront' 'is' 'issaIent' 'issais' 'issait'
 170             'issant' 'issante' 'issantes' 'issants' 'isse' 'issent' 'isses'
 171             'issez' 'issiez' 'issions' 'issons' 'it'
 172                 (non-v delete)
 173         )
 174     )
 175
 176     define verb_suffix as setlimit tomark pV for (
 177         [substring] among (
 178             'ions'
 179                 (R2 delete)
 180
 181             '{e'}' '{e'}e' '{e'}es' '{e'}s' '{e`}rent' 'er' 'era' 'erai'
 182             'eraIent' 'erais' 'erait' 'eras' 'erez' 'eriez' 'erions'
 183             'erons' 'eront' 'ez' 'iez'
 184
 185             // 'ons' //-best omitted
 186
 187                 (delete)
 188
 189             '{a^}mes' '{a^}t' '{a^}tes' 'a' 'ai' 'aIent' 'ais' 'ait' 'ant'
 190             'ante' 'antes' 'ants' 'as' 'asse' 'assent' 'asses' 'assiez'
 191             'assions'
 192                 (delete
 193                  try(['e'] delete)
 194                 )
 195         )
 196     )
 197
 198     define keep_with_s 'aiou{e`}s'
 199
 200     define residual_suffix as (
 201         try(['s'] test non-keep_with_s delete)
 202         setlimit tomark pV for (
 203             [substring] among(
 204                 'ion'           (R2 's' or 't' delete)
 205                 'ier' 'i{e`}re'
 206                 'Ier' 'I{e`}re' (<-'i')
 207                 'e'             (delete)
 208                 '{e"}'          ('gu' delete)
 209             )
 210         )
 211     )
 212
 213     define un_double as (
 214         test among('enn' 'onn' 'ett' 'ell' 'eill') [next] delete
 215     )
 216
 217     define un_accent as (
 218         atleast 1 non-v
 219         [ '{e'}' or '{e`}' ] <-'e'
 220     )
 221 )
 222
 223 define stem as (
 224
 225     do prelude
 226     do mark_regions
 227     backwards (
 228
 229         do (
 230             (
 231                  ( standard_suffix or
 232                    i_verb_suffix or
 233                    verb_suffix
 234                  )
 235                  and
 236                  try( [ ('Y'   ] <- 'i' ) or
 237                         ('{c,}'] <- 'c' )
 238                  )
 239             ) or
 240             residual_suffix
 241         )
 242
 243         // try(['ent'] RV delete) // is best omitted
 244
 245         do un_double
 246         do un_accent
 247     )
 248     do postlude
 249 )
 250