strings ( ch ) integers ( x p1 p2 ) booleans ( Y_found stemmed GE_removed ) routines ( R1 R2 C V VX lengthen_V Step_1 Step_2 Step_3 Step_4 Step_7 Step_6 Step_1c Lose_prefix Lose_infix measure ) externals ( stem ) groupings ( v v_WX AOU AIOU ) stringescapes {} stringdef ' hex '27' // yuk define v 'aeiouy' define v_WX v + 'wx' define AOU 'aou' define AIOU 'aiou' backwardmode ( define R1 as (setmark x \$x >= p1) define R2 as (setmark x \$x >= p2) define V as test (v or 'ij') define VX as test (next v or 'ij') define C as test (not 'ij' non-v) define lengthen_V as do ( non-v_WX [ (AOU] test (non-v or atlimit)) or ('e'] test (non-v or atlimit not AIOU not (next AIOU non-v))) ->ch insert ch ) define Step_1 as ( [among ( (]) '{'}s' (delete) 's' (R1 not ('t' R1) C delete) 'ies' (R1 <-'ie') 'es' (('ar' R1 C ] delete lengthen_V) or ('er' R1 C ] delete) or (R1 C <-'e')) 'aus' (R1 V <-'au') 'en' (('hed' R1 ] <-'heid') or ('nd' delete) or ('d' R1 C ] delete) or ('i' or 'j' V delete) or (R1 C delete lengthen_V)) 'nde' (<-'nd') ) ) define Step_2 as ( [among ( (]) 'je' (('{'}t' ] delete) or ('et' ] R1 C delete) or ('rnt' ] <-'rn') or ('t' ] R1 VX delete) or ('ink' ] <-'ing') or ('mp' ] <-'m') or ('{'}' ] R1 delete) or (] R1 C delete)) 'ge' (R1 <-'g') 'lijke'(R1 <-'lijk') 'ische'(R1 <-'isch') 'de' (R1 C delete) 'te' (R1 <-'t') 'se' (R1 <-'s') 're' (R1 <-'r') 'le' (R1 delete attach 'l' lengthen_V) 'ene' (R1 C delete attach 'en' lengthen_V) 'ieve' (R1 C <-'ief') ) ) define Step_3 as ( [among ( (]) 'atie' (R1 <-'eer') 'iteit' (R1 delete lengthen_V) 'heid' 'sel' 'ster' (R1 delete) 'rder' (<-'r') 'ing' 'isme' 'erij' (R1 delete lengthen_V) 'arij' (R1 C <-'aar') 'fie' (R2 delete attach 'f' lengthen_V) 'gie' (R2 delete attach 'g' lengthen_V) 'tst' (R1 C <-'t') 'dst' (R1 C <-'d') ) ) define Step_4 as ( ( [among ( (]) 'ioneel' (R1 <-'ie') 'atief' (R1 <-'eer') 'baar' (R1 delete) 'naar' (R1 V <-'n') 'laar' (R1 V <-'l') 'raar' (R1 V <-'r') 'tant' (R1 <-'teer') 'lijker' 'lijkst' (R1 <-'lijk') 'achtig' 'achtiger' 'achtigst'(R1 delete) 'eriger' 'erigst' 'erig' 'end' (R1 C delete lengthen_V) ) ) or ( [among ( (]) 'iger' 'igst' 'ig' (R1 C delete lengthen_V) ) ) ) define Step_7 as ( [among ( (]) 'kt' (<-'k') 'ft' (<-'f') 'pt' (<-'p') ) ) define Step_6 as ( [among ( (]) 'bb' (<-'b') 'cc' (<-'c') 'dd' (<-'d') 'ff' (<-'f') 'gg' (<-'g') 'hh' (<-'h') 'jj' (<-'j') 'kk' (<-'k') 'll' (<-'l') 'mm' (<-'m') 'nn' (<-'n') 'pp' (<-'p') 'qq' (<-'q') 'rr' (<-'r') 'ss' (<-'s') 'tt' (<-'t') 'vv' (<-'v') 'ww' (<-'w') 'xx' (<-'x') 'zz' (<-'z') 'v' (<-'f') 'z' (<-'s') ) ) define Step_1c as ( [among ( (] R1 C) 'd' (not ('n' R1) delete) 't' (not ('h' R1) delete) ) ) ) define Lose_prefix as ( ['ge'] test hop 3 (goto v goto non-v) set GE_removed delete ) define Lose_infix as ( next gopast (['ge']) test hop 3 (goto v goto non-v) set GE_removed delete ) define measure as ( do ( tolimit setmark p1 setmark p2 ) do( repeat non-v atleast 1 ('ij' or v) non-v setmark p1 repeat non-v atleast 1 ('ij' or v) non-v setmark p2 ) ) define stem as ( unset Y_found unset stemmed do ( ['y'] <-'Y' set Y_found ) do repeat(goto (v ['y'])<-'Y' set Y_found ) measure backwards ( do (Step_1 set stemmed ) do (Step_2 set stemmed ) do (Step_3 set stemmed ) do (Step_4 set stemmed ) ) unset GE_removed do (Lose_prefix and measure) backwards ( do (GE_removed Step_1c) ) unset GE_removed do (Lose_infix and measure) backwards ( do (GE_removed Step_1c) ) backwards ( do (Step_7 set stemmed ) do (stemmed or GE_removed Step_6) ) do(Y_found repeat(goto (['Y']) <-'y')) )