1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
/*
Extra rule for -nisse ending added 11 Dec 2009
*/
routines (
prelude postlude
mark_regions
R1 R2
standard_suffix
)
externals ( stem )
integers ( p1 p2 x )
groupings ( v s_ending st_ending )
stringescapes {}
/* special characters (in ISO Latin I) */
stringdef a" hex 'E4'
stringdef o" hex 'F6'
stringdef u" hex 'FC'
stringdef ss hex 'DF'
define v 'aeiouy{a"}{o"}{u"}'
define s_ending 'bdfghklmnrt'
define st_ending s_ending - 'r'
define prelude as (
test repeat (
(
['{ss}'] <- 'ss'
) or next
)
repeat goto (
v [('u'] v <- 'U') or
('y'] v <- 'Y')
)
)
define mark_regions as (
$p1 = limit
$p2 = limit
test(hop 3 setmark x)
gopast v gopast non-v setmark p1
try($p1 < x $p1 = x) // at least 3
gopast v gopast non-v setmark p2
)
define postlude as repeat (
[substring] among(
'Y' (<- 'y')
'U' (<- 'u')
'{a"}' (<- 'a')
'{o"}' (<- 'o')
'{u"}' (<- 'u')
'' (next)
)
)
backwardmode (
define R1 as $p1 <= cursor
define R2 as $p2 <= cursor
define standard_suffix as (
do (
[substring] R1 among(
'em' 'ern' 'er'
( delete
)
'e' 'en' 'es'
( delete
try (['s'] 'nis' delete)
)
's'
( s_ending delete
)
)
)
do (
[substring] R1 among(
'en' 'er' 'est'
( delete
)
'st'
( st_ending hop 3 delete
)
)
)
do (
[substring] R2 among(
'end' 'ung'
( delete
try (['ig'] not 'e' R2 delete)
)
'ig' 'ik' 'isch'
( not 'e' delete
)
'lich' 'heit'
( delete
try (
['er' or 'en'] R1 delete
)
)
'keit'
( delete
try (
[substring] R2 among(
'lich' 'ig'
( delete
)
)
)
)
)
)
)
)
define stem as (
do prelude
do mark_regions
backwards
do standard_suffix
do postlude
)