1
2stringescapes {}
3
4routines (
5   A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA BB CC
6
7   endings
8
9   undouble respell
10)
11
12externals ( stem )
13
14backwardmode (
15
16  /* Lovins' conditions A, B ... CC, as given in her Appendix B, where
17     a test for a two letter prefix ('test hop 2') is implicitly
18     assumed. Note that 'e' next 'u' corresponds to her u*e because
19     Snowball is scanning backwards. */
20
21  define A  as ( hop 2 )
22  define B  as ( hop 3 )
23  define C  as ( hop 4 )
24  define D  as ( hop 5 )
25  define E  as ( test hop 2 not 'e' )
26  define F  as ( test hop 3 not 'e' )
27  define G  as ( test hop 3 'f' )
28  define H  as ( test hop 2 't' or 'll' )
29  define I  as ( test hop 2 not 'o' not 'e' )
30  define J  as ( test hop 2 not 'a' not 'e' )
31  define K  as ( test hop 3 'l' or 'i' or ('e' next 'u') )
32  define L  as ( test hop 2 not 'u' not 'x' not ('s' not 'o') )
33  define M  as ( test hop 2 not 'a' not 'c' not 'e' not 'm' )
34  define N  as ( test hop 3 ( hop 2 not 's' or hop 2 ) )
35  define O  as ( test hop 2 'l' or 'i' )
36  define P  as ( test hop 2 not 'c' )
37  define Q  as ( test hop 2 test hop 3 not 'l' not 'n' )
38  define R  as ( test hop 2 'n' or 'r' )
39  define S  as ( test hop 2 'dr' or ('t' not 't') )
40  define T  as ( test hop 2 's' or ('t' not 'o') )
41  define U  as ( test hop 2 'l' or 'm' or 'n' or 'r' )
42  define V  as ( test hop 2 'c' )
43  define W  as ( test hop 2 not 's' not 'u' )
44  define X  as ( test hop 2 'l' or 'i' or ('e' next 'u') )
45  define Y  as ( test hop 2 'in' )
46  define Z  as ( test hop 2 not 'f' )
47  define AA as ( test hop 2 among ( 'd' 'f' 'ph' 'th' 'l' 'er' 'or'
48                                    'es' 't' ) )
49  define BB as ( test hop 3 not 'met' not 'ryst' )
50  define CC as ( test hop 2 'l' )
51
52
53  /* The system of endings, as given in Appendix A. */
54
55  define endings as (
56    [substring] among(
57    'alistically' B 'arizability' A 'izationally' B
58
59     'antialness' A  'arisations' A  'arizations' A  'entialness' A
60
61      'allically' C   'antaneous' A   'antiality' A   'arisation' A
62      'arization' A   'ationally' B   'ativeness' A   'eableness' E
63      'entations' A   'entiality' A   'entialize' A   'entiation' A
64      'ionalness' A   'istically' A   'itousness' A   'izability' A
65      'izational' A
66
67       'ableness' A    'arizable' A    'entation' A    'entially' A
68       'eousness' A    'ibleness' A    'icalness' A    'ionalism' A
69       'ionality' A    'ionalize' A    'iousness' A    'izations' A
70       'lessness' A
71
72        'ability' A     'aically' A     'alistic' B     'alities' A
73        'ariness' E     'aristic' A     'arizing' A     'ateness' A
74        'atingly' A     'ational' B     'atively' A     'ativism' A
75        'elihood' E     'encible' A     'entally' A     'entials' A
76        'entiate' A     'entness' A     'fulness' A     'ibility' A
77        'icalism' A     'icalist' A     'icality' A     'icalize' A
78        'ication' G     'icianry' A     'ination' A     'ingness' A
79        'ionally' A     'isation' A     'ishness' A     'istical' A
80        'iteness' A     'iveness' A     'ivistic' A     'ivities' A
81        'ization' F     'izement' A     'oidally' A     'ousness' A
82
83         'aceous' A      'acious' B      'action' G      'alness' A
84         'ancial' A      'ancies' A      'ancing' B      'ariser' A
85         'arized' A      'arizer' A      'atable' A      'ations' B
86         'atives' A      'eature' Z      'efully' A      'encies' A
87         'encing' A      'ential' A      'enting' C      'entist' A
88         'eously' A      'ialist' A      'iality' A      'ialize' A
89         'ically' A      'icance' A      'icians' A      'icists' A
90         'ifully' A      'ionals' A      'ionate' D      'ioning' A
91         'ionist' A      'iously' A      'istics' A      'izable' E
92         'lessly' A      'nesses' A      'oidism' A
93
94          'acies' A       'acity' A       'aging' B       'aical' A
95          'alist' A       'alism' B       'ality' A       'alize' A
96          'allic'BB       'anced' B       'ances' B       'antic' C
97          'arial' A       'aries' A       'arily' A       'arity' B
98          'arize' A       'aroid' A       'ately' A       'ating' I
99          'ation' B       'ative' A       'ators' A       'atory' A
100          'ature' E       'early' Y       'ehood' A       'eless' A
101          'elity' A       'ement' A       'enced' A       'ences' A
102          'eness' E       'ening' E       'ental' A       'ented' C
103          'ently' A       'fully' A       'ially' A       'icant' A
104          'ician' A       'icide' A       'icism' A       'icist' A
105          'icity' A       'idine' I       'iedly' A       'ihood' A
106          'inate' A       'iness' A       'ingly' B       'inism' J
107          'inity'CC       'ional' A       'ioned' A       'ished' A
108          'istic' A       'ities' A       'itous' A       'ively' A
109          'ivity' A       'izers' F       'izing' F       'oidal' A
110          'oides' A       'otide' A       'ously' A
111
112           'able' A        'ably' A        'ages' B        'ally' B
113           'ance' B        'ancy' B        'ants' B        'aric' A
114           'arly' K        'ated' I        'ates' A        'atic' B
115           'ator' A        'ealy' Y        'edly' E        'eful' A
116           'eity' A        'ence' A        'ency' A        'ened' E
117           'enly' E        'eous' A        'hood' A        'ials' A
118           'ians' A        'ible' A        'ibly' A        'ical' A
119           'ides' L        'iers' A        'iful' A        'ines' M
120           'ings' N        'ions' B        'ious' A        'isms' B
121           'ists' A        'itic' H        'ized' F        'izer' F
122           'less' A        'lily' A        'ness' A        'ogen' A
123           'ward' A        'wise' A        'ying' B        'yish' A
124
125            'acy' A         'age' B         'aic' A         'als'BB
126            'ant' B         'ars' O         'ary' F         'ata' A
127            'ate' A         'eal' Y         'ear' Y         'ely' E
128            'ene' E         'ent' C         'ery' E         'ese' A
129            'ful' A         'ial' A         'ian' A         'ics' A
130            'ide' L         'ied' A         'ier' A         'ies' P
131            'ily' A         'ine' M         'ing' N         'ion' Q
132            'ish' C         'ism' B         'ist' A         'ite'AA
133            'ity' A         'ium' A         'ive' A         'ize' F
134            'oid' A         'one' R         'ous' A
135
136             'ae' A          'al'BB          'ar' X          'as' B
137             'ed' E          'en' F          'es' E          'ia' A
138             'ic' A          'is' A          'ly' B          'on' S
139             'or' T          'um' U          'us' V          'yl' R
140           '{'}s' A        's{'}' A
141
142              'a' A           'e' A           'i' A           'o' A
143              's' W           'y' B
144
145        (delete)
146    )
147  )
148
149  /* Undoubling is rule 1 of appendix C. */
150
151  define undouble as (
152    test substring among ('bb' 'dd' 'gg' 'll' 'mm' 'nn' 'pp' 'rr' 'ss'
153                          'tt')
154    [next] delete
155  )
156
157  /* The other appendix C rules can be done together. */
158
159  define respell as (
160    [substring] among (
161      'iev'  (<-'ief')
162      'uct'  (<-'uc')
163      'umpt' (<-'um')
164      'rpt'  (<-'rb')
165      'urs'  (<-'ur')
166      'istr' (<-'ister')
167      'metr' (<-'meter')
168      'olv'  (<-'olut')
169      'ul'   (not 'a' not 'i' not 'o' <-'l')
170      'bex'  (<-'bic')
171      'dex'  (<-'dic')
172      'pex'  (<-'pic')
173      'tex'  (<-'tic')
174      'ax'   (<-'ac')
175      'ex'   (<-'ec')
176      'ix'   (<-'ic')
177      'lux'  (<-'luc')
178      'uad'  (<-'uas')
179      'vad'  (<-'vas')
180      'cid'  (<-'cis')
181      'lid'  (<-'lis')
182      'erid' (<-'eris')
183      'pand' (<-'pans')
184      'end'  (not 's' <-'ens')
185      'ond'  (<-'ons')
186      'lud'  (<-'lus')
187      'rud'  (<-'rus')
188      'her'  (not 'p' not 't' <-'hes')
189      'mit'  (<-'mis')
190      'ent'  (not 'm' <-'ens')
191        /* 'ent' was 'end' in the 1968 paper - a typo. */
192      'ert'  (<-'ers')
193      'et'   (not 'n' <-'es')
194      'yt'   (<-'ys')
195      'yz'   (<-'ys')
196    )
197  )
198)
199
200define stem as (
201
202  backwards (
203    do endings
204    do undouble
205    do respell
206  )
207)
208
209