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