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