xapian-core/languages/kraaij_pohlmann.sbl

   1 // Alias:
   2
   3 strings ( ch )
   4 integers ( x p1 p2 )
   5 booleans ( Y_found stemmed GE_removed )
   6
   7 routines (
   8
   9    R1 R2
  10    C V VX
  11    lengthen_V
  12    Step_1 Step_2 Step_3 Step_4 Step_7
  13    Step_6 Step_1c
  14    Lose_prefix
  15    Lose_infix
  16    measure
  17 )
  18
  19 externals ( stem )
  20
  21 groupings ( v v_WX AOU AIOU )
  22
  23 stringescapes {}
  24
  25 stringdef '   hex '27'  // yuk
  26
  27 define v        'aeiouy'
  28 define v_WX     v + 'wx'
  29 define AOU      'aou'
  30 define AIOU     'aiou'
  31
  32 backwardmode (
  33
  34     define R1 as (setmark x $x >= p1)
  35     define R2 as (setmark x $x >= p2)
  36
  37     define V  as test (v or 'ij')
  38     define VX as test (next v or 'ij')
  39     define C  as test (not 'ij' non-v)
  40
  41     define lengthen_V as do (
  42         non-v_WX [ (AOU] test (non-v or atlimit)) or
  43                    ('e'] test (non-v or atlimit
  44                                not AIOU
  45                                not (next AIOU non-v)))
  46         ->ch insert ch
  47     )
  48
  49     define Step_1 as
  50     (
  51         [among ( (])
  52
  53             '{'}s' (delete)
  54             's'    (R1 not ('t' R1) C delete)
  55             'ies'  (R1 <-'ie')
  56             'es'
  57                    (('ar' R1 C ] delete lengthen_V) or
  58                     ('er' R1 C ] delete) or
  59                     (R1 C <-'e'))
  60
  61             'aus'  (R1 V <-'au')
  62             'en'   (('hed' R1 ] <-'heid') or
  63                     ('nd' delete) or
  64                     ('d' R1 C ] delete) or
  65                     ('i' or 'j' V delete) or
  66                     (R1 C delete lengthen_V))
  67             'nde'  (<-'nd')
  68         )
  69     )
  70
  71     define Step_2 as
  72     (
  73         [among ( (])
  74             'je'   (('{'}t' ] delete) or
  75                     ('et'   ] R1 C delete) or
  76                     ('rnt'  ] <-'rn') or
  77                     ('t'    ] R1 VX delete) or
  78                     ('ink'  ] <-'ing') or
  79                     ('mp'   ] <-'m') or
  80                     ('{'}'  ] R1 delete) or
  81                     (] R1 C delete))
  82             'ge'   (R1 <-'g')
  83             'lijke'(R1 <-'lijk')
  84             'ische'(R1 <-'isch')
  85             'de'   (R1 C delete)
  86             'te'   (R1 <-'t')
  87             'se'   (R1 <-'s')
  88             're'   (R1 <-'r')
  89             'le'   (R1 delete attach 'l' lengthen_V)
  90             'ene'  (R1 C delete attach 'en' lengthen_V)
  91             'ieve' (R1 C <-'ief')
  92         )
  93     )
  94
  95     define Step_3 as
  96     (
  97         [among ( (])
  98             'atie'  (R1 <-'eer')
  99             'iteit' (R1 delete lengthen_V)
 100             'heid'
 101             'sel'
 102             'ster'  (R1 delete)
 103             'rder'  (<-'r')
 104             'ing'
 105             'isme'
 106             'erij'  (R1 delete lengthen_V)
 107             'arij'  (R1 C <-'aar')
 108             'fie'   (R2 delete attach 'f' lengthen_V)
 109             'gie'   (R2 delete attach 'g' lengthen_V)
 110             'tst'   (R1 C <-'t')
 111             'dst'   (R1 C <-'d')
 112         )
 113     )
 114
 115     define Step_4 as
 116     (
 117         (   [among ( (])
 118                 'ioneel'  (R1 <-'ie')
 119                 'atief'   (R1 <-'eer')
 120                 'baar'    (R1 delete)
 121                 'naar'    (R1 V <-'n')
 122                 'laar'    (R1 V <-'l')
 123                 'raar'    (R1 V <-'r')
 124                 'tant'    (R1 <-'teer')
 125                 'lijker'
 126                 'lijkst'  (R1 <-'lijk')
 127                 'achtig'
 128                 'achtiger'
 129                 'achtigst'(R1 delete)
 130                 'eriger'
 131                 'erigst'
 132                 'erig'
 133                 'end'     (R1 C delete lengthen_V)
 134             )
 135         )
 136         or
 137         (   [among ( (])
 138                 'iger'
 139                 'igst'
 140                 'ig'      (R1 C delete lengthen_V)
 141             )
 142         )
 143     )
 144
 145     define Step_7 as
 146     (
 147         [among ( (])
 148             'kt'   (<-'k')
 149             'ft'   (<-'f')
 150             'pt'   (<-'p')
 151         )
 152     )
 153
 154     define Step_6 as
 155     (
 156         [among ( (])
 157             'bb'   (<-'b')
 158             'cc'   (<-'c')
 159             'dd'   (<-'d')
 160             'ff'   (<-'f')
 161             'gg'   (<-'g')
 162             'hh'   (<-'h')
 163             'jj'   (<-'j')
 164             'kk'   (<-'k')
 165             'll'   (<-'l')
 166             'mm'   (<-'m')
 167             'nn'   (<-'n')
 168             'pp'   (<-'p')
 169             'qq'   (<-'q')
 170             'rr'   (<-'r')
 171             'ss'   (<-'s')
 172             'tt'   (<-'t')
 173             'vv'   (<-'v')
 174             'ww'   (<-'w')
 175             'xx'   (<-'x')
 176             'zz'   (<-'z')
 177             'v'    (<-'f')
 178             'z'    (<-'s')
 179         )
 180     )
 181
 182     define Step_1c as
 183     (
 184         [among ( (] R1 C)
 185             'd' (not ('n' R1) delete)
 186             't' (not ('h' R1) delete)
 187         )
 188     )
 189 )
 190
 191 define Lose_prefix as (
 192     ['ge'] test hop 3 (goto v goto non-v)
 193     set GE_removed
 194     delete
 195 )
 196
 197 define Lose_infix as (
 198     next
 199     gopast (['ge']) test hop 3 (goto v goto non-v)
 200     set GE_removed
 201     delete
 202 )
 203
 204 define measure as (
 205     do (
 206         tolimit
 207         setmark p1
 208         setmark p2
 209     )
 210     do(
 211         repeat non-v  atleast 1 ('ij' or v)  non-v  setmark p1
 212         repeat non-v  atleast 1 ('ij' or v)  non-v  setmark p2
 213     )
 214
 215 )
 216 define stem as (
 217
 218     unset Y_found
 219     unset stemmed
 220     do ( ['y'] <-'Y' set Y_found )
 221     do repeat(goto (v  ['y'])<-'Y' set Y_found )
 222
 223     measure
 224
 225     backwards (
 226             do (Step_1 set stemmed )
 227             do (Step_2 set stemmed )
 228             do (Step_3 set stemmed )
 229             do (Step_4 set stemmed )
 230     )
 231     unset GE_removed
 232     do (Lose_prefix and measure)
 233     backwards (
 234             do (GE_removed Step_1c)
 235         )
 236     unset GE_removed
 237     do (Lose_infix and measure)
 238     backwards (
 239             do (GE_removed Step_1c)
 240         )
 241     backwards (
 242             do (Step_7 set stemmed )
 243             do (stemmed or GE_removed Step_6)
 244         )
 245     do(Y_found  repeat(goto (['Y']) <-'y'))
 246 )
 247