xapian-core/languages/porter.sbl

   1 // Alias:
   2
   3 integers ( p1 p2 )
   4 booleans ( Y_found )
   5
   6 routines (
   7    shortv
   8    R1 R2
   9    Step_1a Step_1b Step_1c Step_2 Step_3 Step_4 Step_5a Step_5b
  10 )
  11
  12 externals ( stem )
  13
  14 groupings ( v v_WXY )
  15
  16 define v        'aeiouy'
  17 define v_WXY    v + 'wxY'
  18
  19 backwardmode (
  20
  21     define shortv as ( non-v_WXY v non-v )
  22
  23     define R1 as $p1 <= cursor
  24     define R2 as $p2 <= cursor
  25
  26     define Step_1a as (
  27         [substring] among (
  28             'sses' (<-'ss')
  29             'ies'  (<-'i')
  30             'ss'   ()
  31             's'    (delete)
  32         )
  33     )
  34
  35     define Step_1b as (
  36         [substring] among (
  37             'eed'  (R1 <-'ee')
  38             'ed'
  39             'ing' (
  40                 test gopast v  delete
  41                 test substring among(
  42                     'at' 'bl' 'iz'
  43                          (<+ 'e')
  44                     'bb' 'dd' 'ff' 'gg' 'mm' 'nn' 'pp' 'rr' 'tt'
  45                     // ignoring double c, h, j, k, q, v, w, and x
  46                          ([next]  delete)
  47                     ''   (atmark p1  test shortv  <+ 'e')
  48                 )
  49             )
  50         )
  51     )
  52
  53     define Step_1c as (
  54         ['y' or 'Y']
  55         gopast v
  56         <-'i'
  57     )
  58
  59     define Step_2 as (
  60         [substring] R1 among (
  61             'tional'  (<-'tion')
  62             'enci'    (<-'ence')
  63             'anci'    (<-'ance')
  64             'abli'    (<-'able')
  65             'entli'   (<-'ent')
  66             'eli'     (<-'e')
  67             'izer' 'ization'
  68                       (<-'ize')
  69             'ational' 'ation' 'ator'
  70                       (<-'ate')
  71             'alli'    (<-'al')
  72             'alism' 'aliti'
  73                       (<-'al')
  74             'fulness' (<-'ful')
  75             'ousli' 'ousness'
  76                       (<-'ous')
  77             'iveness' 'iviti'
  78                       (<-'ive')
  79             'biliti'  (<-'ble')
  80         )
  81     )
  82
  83     define Step_3 as (
  84         [substring] R1 among (
  85             'alize'   (<-'al')
  86             'icate' 'iciti' 'ical'
  87                       (<-'ic')
  88             'ative' 'ful' 'ness'
  89                       (delete)
  90         )
  91     )
  92
  93     define Step_4 as (
  94         [substring] R2 among (
  95             'al' 'ance' 'ence' 'er' 'ic' 'able' 'ible' 'ant' 'ement'
  96             'ment' 'ent' 'ou' 'ism' 'ate' 'iti' 'ous' 'ive' 'ize'
  97                       (delete)
  98             'ion'     ('s' or 't' delete)
  99         )
 100     )
 101
 102     define Step_5a as (
 103         ['e']
 104         R2 or (R1 not shortv)
 105         delete
 106     )
 107
 108     define Step_5b as (
 109         ['l']
 110         R2 'l'
 111         delete
 112     )
 113 )
 114
 115 define stem as (
 116
 117     unset Y_found
 118     do ( ['y'] <-'Y' set Y_found)
 119     do repeat(goto (v ['y']) <-'Y' set Y_found)
 120
 121     $p1 = limit
 122     $p2 = limit
 123     do(
 124         gopast v  gopast non-v  setmark p1
 125         gopast v  gopast non-v  setmark p2
 126     )
 127
 128     backwards (
 129         do Step_1a
 130         do Step_1b
 131         do Step_1c
 132         do Step_2
 133         do Step_3
 134         do Step_4
 135         do Step_5a
 136         do Step_5b
 137     )
 138
 139     do(Y_found  repeat(goto (['Y']) <-'y'))
 140
 141 )