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.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  1. routines (
  2. mark_regions
  3. main_suffix
  4. consonant_pair
  5. other_suffix
  6. )
  7. externals ( stem )
  8. integers ( p1 x )
  9. groupings ( v s_ending )
  10. stringescapes {}
  11. /* special characters */
  12. stringdef ae '{U+00E6}'
  13. stringdef ao '{U+00E5}'
  14. stringdef o/ '{U+00F8}'
  15. define v 'aeiouy{ae}{ao}{o/}'
  16. define s_ending 'bcdfghjlmnoprtvyz'
  17. define mark_regions as (
  18. $p1 = limit
  19. test ( hop 3 setmark x )
  20. goto v gopast non-v setmark p1
  21. try ( $p1 < x $p1 = x )
  22. )
  23. backwardmode (
  24. define main_suffix as (
  25. setlimit tomark p1 for ([substring])
  26. among(
  27. 'a' 'e' 'ede' 'ande' 'ende' 'ane' 'ene' 'hetene' 'en' 'heten' 'ar'
  28. 'er' 'heter' 'as' 'es' 'edes' 'endes' 'enes' 'hetenes' 'ens'
  29. 'hetens' 'ers' 'ets' 'et' 'het' 'ast'
  30. (delete)
  31. 's'
  32. (s_ending or ('k' non-v) delete)
  33. 'erte' 'ert'
  34. (<-'er')
  35. )
  36. )
  37. define consonant_pair as (
  38. test (
  39. setlimit tomark p1 for ([substring])
  40. among(
  41. 'dt' 'vt'
  42. )
  43. )
  44. next] delete
  45. )
  46. define other_suffix as (
  47. setlimit tomark p1 for ([substring])
  48. among(
  49. 'leg' 'eleg' 'ig' 'eig' 'lig' 'elig' 'els' 'lov' 'elov' 'slov'
  50. 'hetslov'
  51. (delete)
  52. )
  53. )
  54. )
  55. define stem as (
  56. do mark_regions
  57. backwards (
  58. do main_suffix
  59. do consonant_pair
  60. do other_suffix
  61. )
  62. )