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