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.

danish.sbl 1.8KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293
  1. routines (
  2. mark_regions
  3. main_suffix
  4. consonant_pair
  5. other_suffix
  6. undouble
  7. )
  8. externals ( stem )
  9. strings ( ch )
  10. integers ( p1 x )
  11. groupings ( c v s_ending )
  12. stringescapes {}
  13. /* special characters */
  14. stringdef ae '{U+00E6}'
  15. stringdef ao '{U+00E5}'
  16. stringdef o/ '{U+00F8}'
  17. define c 'bcdfghjklmnpqrstvwxz'
  18. define v 'aeiouy{ae}{ao}{o/}'
  19. define s_ending 'abcdfghjklmnoprtvyz{ao}'
  20. define mark_regions as (
  21. $p1 = limit
  22. test ( hop 3 setmark x )
  23. goto v gopast non-v setmark p1
  24. try ( $p1 < x $p1 = x )
  25. )
  26. backwardmode (
  27. define main_suffix as (
  28. setlimit tomark p1 for ([substring])
  29. among(
  30. 'hed' 'ethed' 'ered' 'e' 'erede' 'ende' 'erende' 'ene' 'erne' 'ere'
  31. 'en' 'heden' 'eren' 'er' 'heder' 'erer' 'heds' 'es' 'endes'
  32. 'erendes' 'enes' 'ernes' 'eres' 'ens' 'hedens' 'erens' 'ers' 'ets'
  33. 'erets' 'et' 'eret'
  34. (delete)
  35. 's'
  36. (s_ending delete)
  37. )
  38. )
  39. define consonant_pair as (
  40. test (
  41. setlimit tomark p1 for ([substring])
  42. among(
  43. 'gd' // significant in the call from other_suffix
  44. 'dt' 'gt' 'kt'
  45. )
  46. )
  47. next] delete
  48. )
  49. define other_suffix as (
  50. do ( ['st'] 'ig' delete )
  51. setlimit tomark p1 for ([substring])
  52. among(
  53. 'ig' 'lig' 'elig' 'els'
  54. (delete do consonant_pair)
  55. 'l{o/}st'
  56. (<-'l{o/}s')
  57. )
  58. )
  59. define undouble as (
  60. setlimit tomark p1 for ([c] ->ch)
  61. ch
  62. delete
  63. )
  64. )
  65. define stem as (
  66. do mark_regions
  67. backwards (
  68. do main_suffix
  69. do consonant_pair
  70. do other_suffix
  71. do undouble
  72. )
  73. )