text_stemmer

routines (
           et_condition
           mark_regions
           main_suffix
           consonant_pair
           other_suffix
)

externals ( stem )

integers ( p1 x )

groupings ( v s_ending ost_ending )

stringescapes {}

/* special characters */

stringdef a"   '{U+00E4}'
stringdef ao   '{U+00E5}'
stringdef o"   '{U+00F6}'

define v 'aeiouy{a"}{ao}{o"}'

define s_ending  'bcdfghjklmnoprtvy'

define ost_ending 'iklnprtuv'

define mark_regions as (

    $p1 = limit
    test ( hop 3 setmark x )
    gopast v  gopast non-v  setmark p1
    try ( $p1 < x  $p1 = x )
)

backwardmode (

    define et_condition as (
        (non-v v not atlimit)
        and not among (
            // frihet, nyhet, råhet, trohet
            'h'
            // societet
            'iet'
            // annuitet, kontinuitet
            'uit'
            // alfabet
            'fab'
            // autenticitet, elektricitet, kapacitet, metallicitet, publicitet
            'cit'
            // graviditet, likviditet, rigiditet
            'dit'
            // neutralitet, rivalitet, sexualitet
            'alit'
            // flexibilitet, instabilitet, kompatibilitet, mobilitet, variabilitet
            'ilit'
            // anonymitet, intimitet, legitimitet
            'mit'
            // kommunitet, maskulinitet, modernitet, spontanitet, suveränitet
            'nit'
            // epitet, serendipitet
            'pit'
            // auktoritet, integritet, majoritet, popularitet, prioritet
            'rit'
            // densitet, generositet, intensitet, luminositet, viskositet
            'sit'
            // identitet, kvantitet
            'tit'
            // aggressivitet, positivitet
            'ivit'
            // antikvitet, oblikvitet
            'kvit'
            // komplexitet
            'xit'
            // komet
            'kom'
            // raket
            'rak'
            // paket
            'pak'
            // staket
            'stak'
        )
    )

    define main_suffix as (
        setlimit tomark p1 for ([substring])
        among(

            'a' 'arna' 'erna' 'heterna' 'orna' 'ad' 'e' 'ade' 'ande' 'arne'
            'are' 'aste' 'en' 'anden' 'aren' 'heten' 'ern' 'ar' 'er' 'heter'
            'or' 'as' 'arnas' 'ernas' 'ornas' 'es' 'ades' 'andes' 'ens' 'arens'
            'hetens' 'erns' 'at' 'andet' 'het' 'ast'
                (delete)
            's'
                ( ('et' et_condition ]) or s_ending  delete )
            'et'
                ( et_condition delete )
        )
    )

    define consonant_pair as setlimit tomark p1 for (
        among('dd' 'gd' 'nn' 'dt' 'gt' 'kt' 'tt')
        and ([next] delete)
    )

    define other_suffix as (
        setlimit tomark p1 for ([substring])
        among(
            'lig' 'ig' 'els' (delete)
            '{o"}st'         (ost_ending <-'{o"}s')
            'fullt'          (<-'full')
        )
    )
)

define stem as (

    do mark_regions
    backwards (
        do main_suffix
        do consonant_pair
        do other_suffix
    )
)