You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164
  1. routines (
  2. prelude postlude
  3. e_ending
  4. en_ending
  5. mark_regions
  6. R1 R2
  7. undouble
  8. standard_suffix
  9. )
  10. externals ( stem )
  11. booleans ( e_found )
  12. integers ( p1 p2 )
  13. groupings ( v v_I v_j )
  14. stringescapes {}
  15. /* special characters */
  16. stringdef a" '{U+00E4}'
  17. stringdef e" '{U+00EB}'
  18. stringdef i" '{U+00EF}'
  19. stringdef o" '{U+00F6}'
  20. stringdef u" '{U+00FC}'
  21. stringdef a' '{U+00E1}'
  22. stringdef e' '{U+00E9}'
  23. stringdef i' '{U+00ED}'
  24. stringdef o' '{U+00F3}'
  25. stringdef u' '{U+00FA}'
  26. stringdef e` '{U+00E8}'
  27. define v 'aeiouy{e`}'
  28. define v_I v + 'I'
  29. define v_j v + 'j'
  30. define prelude as (
  31. test repeat (
  32. [substring] among(
  33. '{a"}' '{a'}'
  34. (<- 'a')
  35. '{e"}' '{e'}'
  36. (<- 'e')
  37. '{i"}' '{i'}'
  38. (<- 'i')
  39. '{o"}' '{o'}'
  40. (<- 'o')
  41. '{u"}' '{u'}'
  42. (<- 'u')
  43. '' (next)
  44. ) //or next
  45. )
  46. try(['y'] <- 'Y')
  47. repeat goto (
  48. v [('i'] v <- 'I') or
  49. ('y'] <- 'Y')
  50. )
  51. )
  52. define mark_regions as (
  53. $p1 = limit
  54. $p2 = limit
  55. gopast v gopast non-v setmark p1
  56. try($p1 < 3 $p1 = 3) // at least 3
  57. gopast v gopast non-v setmark p2
  58. )
  59. define postlude as repeat (
  60. [substring] among(
  61. 'Y' (<- 'y')
  62. 'I' (<- 'i')
  63. '' (next)
  64. ) //or next
  65. )
  66. backwardmode (
  67. define R1 as $p1 <= cursor
  68. define R2 as $p2 <= cursor
  69. define undouble as (
  70. test among('kk' 'dd' 'tt') [next] delete
  71. )
  72. define e_ending as (
  73. unset e_found
  74. ['e'] R1 test non-v delete
  75. set e_found
  76. undouble
  77. )
  78. define en_ending as (
  79. R1 non-v and not 'gem' delete
  80. undouble
  81. )
  82. define standard_suffix as (
  83. do (
  84. [substring] among(
  85. 'heden'
  86. ( R1 <- 'heid'
  87. )
  88. 'en' 'ene'
  89. ( en_ending
  90. )
  91. 's' 'se'
  92. ( R1 non-v_j delete
  93. )
  94. )
  95. )
  96. do e_ending
  97. do ( ['heid'] R2 not 'c' delete
  98. ['en'] en_ending
  99. )
  100. do (
  101. [substring] among(
  102. 'end' 'ing'
  103. ( R2 delete
  104. (['ig'] R2 not 'e' delete) or undouble
  105. )
  106. 'ig'
  107. ( R2 not 'e' delete
  108. )
  109. 'lijk'
  110. ( R2 delete e_ending
  111. )
  112. 'baar'
  113. ( R2 delete
  114. )
  115. 'bar'
  116. ( R2 e_found delete
  117. )
  118. )
  119. )
  120. do (
  121. non-v_I
  122. test (
  123. among ('aa' 'ee' 'oo' 'uu')
  124. non-v
  125. )
  126. [next] delete
  127. )
  128. )
  129. )
  130. define stem as (
  131. do prelude
  132. do mark_regions
  133. backwards
  134. do standard_suffix
  135. do postlude
  136. )