mittens 0.3.0 → 0.3.2

data/vendor/snowball/ada/src/stemmer.ads

@@ -36,18 +36,18 @@ package Stemmer with SPARK_Mode is
    type Context_Type is abstract tagged private;
 
    --  Apply the stemming algorithm on the word initialized in the context.
-   procedure Stem (Context : in out Context_Type;
-                   Result  : out Boolean) is abstract;
+   procedure Stem (Z      : in out Context_Type;
+                   Result : out Boolean) is abstract;
 
    --  Stem the word and return True if it was reduced.
-   procedure Stem_Word (Context  : in out Context_Type'Class;
-                        Word     : in String;
-                        Result   : out Boolean) with
+   procedure Stem_Word (Z      : in out Context_Type'Class;
+                        Word   : in String;
+                        Result : out Boolean) with
      Global => null,
      Pre => Word'Length < WORD_MAX_LENGTH;
 
    --  Get the stem or the input word unmodified.
-   function Get_Result (Context : in Context_Type'Class) return String with
+   function Get_Result (Z : in Context_Type'Class) return String with
      Global => null,
      Post => Get_Result'Result'Length < WORD_MAX_LENGTH;
 
@@ -82,19 +82,19 @@ private
 
    type Among_Array_Type is array (Natural range <>) of Among_Type;
 
-   function Eq_S (Context : in Context_Type'Class;
-                  S       : in String) return Char_Index with
-     Global => null,
-     Pre => S'Length > 0,
-     Post => Eq_S'Result = 0 or Eq_S'Result = S'Length;
+   procedure Eq_S (Z      : in out Context_Type'Class;
+                   S      : in String;
+                   Len    : in Char_Index;
+                   Result : out Boolean) with
+     Global => null;
 
-   function Eq_S_Backward (Context : in Context_Type'Class;
-                           S       : in String) return Char_Index with
-     Global => null,
-     Pre => S'Length > 0,
-     Post => Eq_S_Backward'Result = 0 or Eq_S_Backward'Result = S'Length;
+   procedure Eq_S_Backward (Z      : in out Context_Type'Class;
+                            S      : in String;
+                            Len    : in Char_Index;
+                            Result : out Boolean) with
+     Global => null;
 
-   procedure Find_Among (Context : in out Context_Type'Class;
+   procedure Find_Among (Z       : in out Context_Type'Class;
                          Amongs  : in Among_Array_Type;
                          Pattern : in String;
                          Execute : access procedure
@@ -105,7 +105,7 @@ private
      Global => null,
      Pre => Pattern'Length > 0 and Amongs'Length > 0;
 
-   procedure Find_Among_Backward (Context : in out Context_Type'Class;
+   procedure Find_Among_Backward (Z       : in out Context_Type'Class;
                                   Amongs  : in Among_Array_Type;
                                   Pattern : in String;
                                   Execute : access procedure
@@ -116,92 +116,89 @@ private
      Global => null,
      Pre => Pattern'Length > 0 and Amongs'Length > 0;
 
-   function Skip_Utf8 (Context : in Context_Type'Class) return Result_Index with
+   function Skip_Utf8 (Z : in Context_Type'Class) return Result_Index with
      Global => null;
 
-   function Skip_Utf8 (Context : in Context_Type'Class;
-                       N       : in Integer) return Result_Index with
+   function Skip_Utf8 (Z : in Context_Type'Class;
+                       N : in Integer) return Result_Index with
      Global => null;
 
-   function Skip_Utf8_Backward (Context : in Context_Type'Class) return Result_Index with
+   function Skip_Utf8_Backward (Z : in Context_Type'Class) return Result_Index with
      Global => null;
 
-   function Skip_Utf8_Backward (Context : in Context_Type'Class;
-                                N       : in Integer) return Result_Index with
+   function Skip_Utf8_Backward (Z : in Context_Type'Class;
+                                N : in Integer) return Result_Index with
      Global => null;
 
-   procedure Get_Utf8 (Context : in Context_Type'Class;
-                       Value   : out Utf8_Type;
-                       Count   : out Natural);
-
-   procedure Get_Utf8_Backward (Context : in Context_Type'Class;
-                                Value   : out Utf8_Type;
-                                Count   : out Natural);
-
-   function Length_Utf8 (Context : in Context_Type'Class) return Natural;
-
-   function Length_Utf8 (S : in String) return Natural;
-
-   function Check_Among (Context : in Context_Type'Class;
-                         Pos     : in Char_Index;
-                         Shift   : in Natural;
-                         Mask    : in Mask_Type) return Boolean;
-
-   procedure Out_Grouping (Context : in out Context_Type'Class;
-                           S       : in Grouping_Array;
-                           Min     : in Utf8_Type;
-                           Max     : in Utf8_Type;
-                           Repeat  : in Boolean;
-                           Result  : out Result_Index);
-
-   procedure Out_Grouping_Backward (Context : in out Context_Type'Class;
-                                    S       : in Grouping_Array;
-                                    Min     : in Utf8_Type;
-                                    Max     : in Utf8_Type;
-                                    Repeat  : in Boolean;
-                                    Result  : out Result_Index);
-
-   procedure In_Grouping (Context : in out Context_Type'Class;
-                          S       : in Grouping_Array;
-                          Min     : in Utf8_Type;
-                          Max     : in Utf8_Type;
-                          Repeat  : in Boolean;
-                          Result  : out Result_Index);
-
-   procedure In_Grouping_Backward (Context : in out Context_Type'Class;
-                                   S       : in Grouping_Array;
-                                   Min     : in Utf8_Type;
-                                   Max     : in Utf8_Type;
-                                   Repeat  : in Boolean;
-                                   Result  : out Result_Index);
-
-   procedure Replace (Context    : in out Context_Type'Class;
-                      C_Bra      : in Char_Index;
-                      C_Ket      : in Char_Index;
-                      S          : in String;
-                      Adjustment : out Integer) with
+   procedure Get_Utf8 (Z     : in Context_Type'Class;
+                       Value : out Utf8_Type;
+                       Count : out Natural);
+
+   procedure Get_Utf8_Backward (Z     : in Context_Type'Class;
+                                Value : out Utf8_Type;
+                                Count : out Natural);
+
+   function Length_Utf8 (S   : in String;
+                         Len : in Char_Index) return Natural;
+
+   function Check_Among (Z     : in Context_Type'Class;
+                         Pos   : in Char_Index;
+                         Shift : in Natural;
+                         Mask  : in Mask_Type) return Boolean;
+
+   procedure Out_Grouping (Z      : in out Context_Type'Class;
+                           S      : in Grouping_Array;
+                           Min    : in Utf8_Type;
+                           Max    : in Utf8_Type;
+                           Repeat : in Boolean;
+                           Result : out Result_Index);
+
+   procedure Out_Grouping_Backward (Z      : in out Context_Type'Class;
+                                    S      : in Grouping_Array;
+                                    Min    : in Utf8_Type;
+                                    Max    : in Utf8_Type;
+                                    Repeat : in Boolean;
+                                    Result : out Result_Index);
+
+   procedure In_Grouping (Z      : in out Context_Type'Class;
+                          S      : in Grouping_Array;
+                          Min    : in Utf8_Type;
+                          Max    : in Utf8_Type;
+                          Repeat : in Boolean;
+                          Result : out Result_Index);
+
+   procedure In_Grouping_Backward (Z      : in out Context_Type'Class;
+                                   S      : in Grouping_Array;
+                                   Min    : in Utf8_Type;
+                                   Max    : in Utf8_Type;
+                                   Repeat : in Boolean;
+                                   Result : out Result_Index);
+
+   procedure Replace (Z     : in out Context_Type'Class;
+                      C_Bra : in Char_Index;
+                      C_Ket : in Char_Index;
+                      S     : in String;
+                      Len   : in Char_Index) with
      Global => null,
-     Pre => C_Ket >= C_Bra;
+     Pre => C_Bra <= C_Ket and C_Ket <= Z.Len
+     and Z.Len + Len - (C_Ket - C_Bra) < Z.P'Length;
 
-   procedure Slice_Del (Context : in out Context_Type'Class) with
+   procedure Slice_Del (Z : in out Context_Type'Class) with
      Global => null,
-     Pre => Context.Ket >= Context.Bra;
+     Pre => Z.Bra <= Z.Ket and Z.Ket <= Z.Len;
 
-   procedure Slice_From (Context : in out Context_Type'Class;
-                         Text    : in String) with
+   procedure Slice_From (Z    : in out Context_Type'Class;
+                         Text : in String;
+                         Len  : in Char_Index) with
      Global => null,
-     Pre => Context.Ket >= Context.Bra
-     and Context.Len - (Context.Ket - Context.Bra) + Text'Length < Context.P'Length;
-
-   function Slice_To (Context : in Context_Type'Class) return String;
+     Pre => Z.Bra <= Z.Ket and Z.Ket <= Z.Len;
 
-   procedure Insert (Context : in out Context_Type'Class;
-                     C_Bra   : in Char_Index;
-                     C_Ket   : in Char_Index;
-                     S       : in String) with
+   procedure Insert (Z   : in out Context_Type'Class;
+                     S   : in String;
+                     Len : in Char_Index) with
      Global => null,
-     Pre => C_Ket >= C_Bra
-     and Context.Len - (C_Ket - C_Bra) + S'Length < Context.P'Length;
+     Pre => Z.C <= Z.Len
+     and Z.Len + Len < Z.P'Length;
 
    --  The context indexes follow the C paradigm: they start at 0 for the first character.
    --  This is necessary because several algorithms rely on this when they compare the

data/vendor/snowball/ada/src/stemwords.adb

@@ -5,38 +5,54 @@ procedure Stemwords is
 
    use Stemmer.Factory;
 
-   function Get_Language (Name : in String) return Language_Type;
+   function Get_Language (Name : in String;
+                          Error: out Boolean) return Language_Type;
    function Is_Space (C : in Character) return Boolean;
+   procedure Show_Usage;
 
    function Is_Space (C : in Character) return Boolean is
    begin
       return C = ' ' or C = ASCII.HT;
    end Is_Space;
 
-   function Get_Language (Name : in String) return Language_Type is
+   function Get_Language (Name : in String;
+                          Error: out Boolean) return Language_Type is
    begin
+      Error := False;
       return Language_Type'Value ("L_" & Name);
 
    exception
       when Constraint_Error =>
          Ada.Text_IO.Put_Line ("Unsupported language: " & Name);
-         return L_ENGLISH;
+         Error := True;
+         return Language_Type'Val (0);
 
    end Get_Language;
 
+   procedure Show_Usage is
+   begin
+      Ada.Text_IO.Put_Line ("Usage: stemwords <language> <input file> <output file>");
+      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure);
+   end Show_Usage;
+
    Count  : constant Natural := Ada.Command_Line.Argument_Count;
 begin
    if Count /= 3 then
-      Ada.Text_IO.Put_Line ("Usage: stemwords <language> <input file> <output file>");
+      Show_Usage;
       return;
    end if;
    declare
-      Lang      : constant Language_Type := Get_Language (Ada.Command_Line.Argument (1));
+      Bad_Usage : Boolean := False;
+      Lang      : constant Language_Type := Get_Language (Ada.Command_Line.Argument (1), Bad_Usage);
       Input     : constant String := Ada.Command_Line.Argument (2);
       Output    : constant String := Ada.Command_Line.Argument (3);
       Src_File  : Ada.Text_IO.File_Type;
       Dst_File  : Ada.Text_IO.File_Type;
    begin
+      if Bad_Usage then
+         Show_Usage;
+         return;
+      end if;
       Ada.Text_IO.Open (Src_File, Ada.Text_IO.In_File, Input);
       Ada.Text_IO.Create (Dst_File, Ada.Text_IO.Out_File, Output);
       while not Ada.Text_IO.End_Of_File (Src_File) loop

data/vendor/snowball/algorithms/czech.sbl

@@ -0,0 +1,255 @@
+routines (
+  R1
+  palatalise_e
+  palatalise_i
+  mark_regions
+  possessive_suffix
+  case_suffix
+)
+
+externals ( stem )
+
+integers ( p1 x )
+
+groupings ( env_ending ev_ending v v_or_syllabic_c )
+
+stringescapes {}
+
+stringdef a' '{U+00E1}' // á
+stringdef cv '{U+010D}' // č
+stringdef dv '{U+010F}' // ď
+stringdef e' '{U+00E9}' // é
+stringdef ev '{U+011B}' // ě
+stringdef i' '{U+00ED}' // í
+stringdef nv '{U+0148}' // ň
+stringdef o' '{U+00F3}' // ó
+stringdef rv '{U+0159}' // ř
+stringdef sv '{U+0161}' // š
+stringdef tv '{U+0165}' // ť
+stringdef u' '{U+00FA}' // ú
+stringdef uo '{U+016F}' // ů
+stringdef y' '{U+00FD}' // ý
+stringdef zv '{U+017E}' // ž
+
+define v 'aeiouy{a'}{ev}{e'}{i'}{o'}{u'}{uo}{y'}'
+
+// Some consonants in Czech can be syllabic - if these occur between two other
+// consonants then they act in a vowel-like way and it is helpful to include
+// them in the definition of R1.
+//
+// Some sources also list 'm' and 'n' as syllabic consonants for Czech but they
+// seem to be much rarer and including them makes no difference to the results
+// of stemming any words in our sample vocabulary list.  Checking on a larger
+// vocabulary list (also from wikipedia but with a lower cut-off frequency)
+// all but one of the affected words don't seem to actually be Czech words.
+define v_or_syllabic_c v + 'lr'
+
+// Letters that can occur before -ev.  Actual known exceptions include
+// 'j' (objev, projev, výjev) and 'ř' (ohřev)
+define ev_ending 'hknrtz'
+
+// Letters that can occur before -eň.  Actual known exceptions include
+// 'g' (Irgeň), 'l' (zeleň), 'm' (kameň) and 'ř' (třeň).
+define env_ending 'bc{cv}dhkprs{sv}tvz{zv}'
+
+define mark_regions as (
+
+    test (hop 3 setmark x) // Signals f if the input < 3 characters.
+
+    $p1 = limit
+    do (
+        // A syllabic consonant must occur between two consonants, or be
+        // preceded by a consonant and at the end of the word.
+        //
+        // Instead of literally testing that, we handle the first character
+        // specially by only checking if it's a vowel; for subsequent
+        // characters we know that the character before is a consonant because
+        // otherwise we'd have stopped already.
+        //
+        // We also don't actually need to check the character after, since
+        // if it's a vowel then that vowel means we'd end up at the same
+        // position after `gopast non-v` anyway, and if it's the end of the
+        // word then there's no non-v after it.
+        (v or (next gopast v_or_syllabic_c)) gopast non-v
+        setmark p1
+        try($p1 < x  $p1 = x)  // at least 3
+    )
+)
+
+backwardmode (
+
+  define R1 as $p1 <= cursor
+
+  define palatalise_e as (
+    [substring] among (
+      // -c -> -k
+      'c'
+        (<- 'k')
+      'nc' // e.g. finance
+      'avc' // e.g. dravce
+      'ovc' // e.g. jalovce
+        ()
+      '{i'}nc' // e.g. podmínce
+        (<- '{i'}nk')
+    )
+  )
+
+  define palatalise_i as (
+    [substring] among (
+      // -c -> -k
+      'c'
+        (<- 'k')
+      'nc' // e.g. financí
+      'avc' // e.g. nástavci
+      'ovc' // e.g. pískovci
+        ()
+      '{i'}nc' // e.g. Gruzínci
+        (<- '{i'}nk')
+
+      '{cv}t' (<- 'ck')
+
+      // -št -> -sk
+      '{sv}t' // e.g. čeština
+        (<-'sk')
+      '{a'}{sv}t' // e.g. plášti
+      'de{sv}t' // e.g. dešti
+      'i{sv}t' // e.g. bojišti
+      '{i'}{sv}t' // e.g. příští
+      'le{sv}t' // e.g. kleští
+      'pou{sv}t' // e.g. poušti, spouští
+        ()
+    )
+  )
+
+  define possessive_suffix as (
+    [substring] R1 among (
+      'ov' '{uo}v'
+      (delete)
+      'in'
+      (
+        delete
+        try palatalise_i
+      )
+    )
+  )
+
+  define case_suffix as (
+    setlimit tomark p1 for ( [substring] ) among (
+      'atech'
+      'at{uo}m'
+      '{a'}ch' '{y'}ch' 'ov{e'}' '{y'}mi'
+      'ata' 'aty' 'ama' 'ami' 'ovi'
+      'at' '{a'}m' 'us' '{uo}m' '{y'}m' 'mi' 'ou'
+      '{e'}ho' '{e'}m' '{e'}mu'
+      'u' 'y' '{uo}' 'a' 'o' '{a'}' '{e'}' '{y'}'
+      (delete)
+      '{ev}' '{ev}tem' '{ev}mi' '{ev}te' '{ev}ti'
+      '{ev}m' // e.g. koněm
+      (
+        delete
+      )
+      'e' 'ech' 'em' 'emi'
+      (
+        delete
+        try palatalise_e
+      )
+      'ete' 'eti' 'etem'
+      (
+        // t-stem neuter nouns
+        among (
+          '{cv}'  // e.g. dvojč-etem
+          'l'     // e.g. batol-ete
+          '{rv}'  // e.g. zvíř-ete
+          's'     // e.g. pras-ete
+          '{zv}'  // e.g. páž-ete
+              (delete)
+          'e{cv}' // e.g. pečet-i
+          'tl'    // e.g. atlet-i
+          'es'    // e.g. deset-i
+          ''
+              (
+                // Remove -e, -i, or -em; stem now ends -et so no palatalise
+                // step is needed.
+                <-'et'
+              )
+        )
+      )
+      'eb'
+      ( // Conflate e.g. skladeb with skladba, skladbě, skladby, etc.
+        test non-v
+        not 't{rv}' // potřeb
+        <-'b'
+      )
+      'ec'
+      ( // Conflate e.g. obec with obce, obcemi, obci, obcí, obcích.
+        test non-v
+        delete attach 'c'
+        try palatalise_e
+      )
+      'ek'
+      ( // Conflate e.g. článek with článkem, článku, článků, článkům, články.
+        test non-v
+        not among (
+          'dot' // dotek
+          'obl' // oblek
+          'sn' // česnek
+        )
+        <-'k'
+      )
+      '{ev}k'
+      ( // Conflate e.g. daněk with daňka, daňkem, daňki, daňkovi, daňků, etc.
+        'n'] <-'{nv}k'
+      )
+      'e{nv}'
+      ( // Conflate e.g. Plzeň with Plzně, Plzni, Plzní.
+        test env_ending
+        <-'n' // -eň -> -n not -ň
+      )
+      // -eš can also lose the -e- but this seems very uncommon - the only
+      // example I've seen is Aleš (a male given name or diminutive name)
+      // but we require 3 characters before R1 so this won't be considered
+      // for stemming.
+      //
+      // Also this can decline as Alše or Aleše, etc, and these alternative
+      // declensions mean that just removing the -e- from Aleš would not
+      // really help (especially as the forms which keep the -e- seem
+      // more common, at least based on cs.wikipedia.org) so if we did this
+      // we would need to also remove -e- from Aleše, etc, which seems a lot
+      // of complication for a single word.
+      'et'
+      ( // Conflate e.g. počet with počte, počtu, počty, etc.
+        among (
+          'uc' // e.g. tucet but not dvacet.
+          '{cv}'
+          'h'
+          'ok' // e.g. loket but not paket.
+          'kar' // e.g. karet but not cigaret.
+        )
+        <-'t'
+      )
+      'ev'
+      ( // Conflate e.g. církev with církve, církve, církvemu, církví, etc.
+        ev_ending
+        <-'v'
+      )
+      '{tv}' '{tv}mi'
+      ( // Conflate e.g. oběť and oběťmi with obětech; hradišť with hradišti.
+        <-'t'
+      )
+      'i'
+      '{i'}' '{i'}ch' '{i'}ho' '{i'}m' '{i'}mi' '{i'}mu'
+      (
+        delete
+        try palatalise_i
+      )
+    )
+  )
+)
+
+define stem as (
+  mark_regions // Signals f if the input has < 3 characters.
+  backwards (
+    do case_suffix
+    do possessive_suffix
+  )
+)

data/vendor/snowball/algorithms/danish.sbl

@@ -10,9 +10,9 @@ externals ( stem )
 
 strings ( ch )
 
-integers ( p1 x )
+integers ( p1 )
 
-groupings ( c v s_ending )
+groupings ( undouble_c v s_ending )
 
 stringescapes {}
 
@@ -22,19 +22,29 @@ stringdef ae   '{U+00E6}'
 stringdef ao   '{U+00E5}'
 stringdef o/   '{U+00F8}'
 
-define c 'bcdfghjklmnpqrstvwxz'
+// Consonants which get undoubled by routine `undouble`.
+define undouble_c 'bdfgklmnprst'
 
 define v 'aeiouy{ae}{ao}{o/}'
 
-define s_ending  'abcdfghjklmnoprtvyz{ao}'
+define s_ending  'abcdfghjklmnoprtvyz{ao}{'}'
 
 define mark_regions as (
-
     $p1 = limit
 
-    test ( hop 3 setmark x )
-    gopast v  gopast non-v  setmark p1
-    try ( $p1 < x  $p1 = x )
+    do (
+      (
+        // If there's an apostrophe, start R1 after it to handle
+        // acronym loanwords such as "pc'en" and "ep'en".
+        gopast '{'}'
+      ) or (
+        gopast v  gopast non-v
+      )
+      setmark p1
+    )
+
+    // Ensure at least 3 characters before R1.
+    test (hop 3  do ($p1 < cursor  $p1 = cursor))
 )
 
 backwardmode (
@@ -75,7 +85,7 @@ backwardmode (
         )
     )
     define undouble as (
-        setlimit tomark p1 for ([c] ->ch)
+        setlimit tomark p1 for ([undouble_c] ->ch)
         ch
         delete
     )
@@ -83,11 +93,13 @@ backwardmode (
 
 define stem as (
 
-    do mark_regions
+    mark_regions
     backwards (
         do main_suffix
         do consonant_pair
         do other_suffix
         do undouble
+        // Remove trailing apostrophe.
+        ['{'}'] delete
     )
 )

data/vendor/snowball/algorithms/english.sbl

@@ -42,6 +42,7 @@ define mark_regions as (
             'later'   // lateral/later
             'emerg'   // emerge/emergency
             'organ'   // organ/organic/organize
+            'inter'   // intern/internal/international/internment; interfere; interval
             // ... extensions possible here ...
         ) or (gopast v  gopast non-v)
         setmark p1
@@ -83,11 +84,12 @@ backwardmode (
             'eed' 'eedly'
                 (
                 do (
+                    R1
                     among (
                         'proc' 'exc' 'succ'
                             (atlimit)
                     ) or (
-                        R1 <-'ee'
+                        <-'ee'
                     )
                 )
             )
@@ -99,7 +101,7 @@ backwardmode (
                     // dying->die, lying->die, tying->tie, vying->vie
                     'y'
                         (test(non-v atlimit) ] <-'ie')
-                    // Leave inning, outing, etc along.
+                    // Leave inning, outing, etc alone.
                     'inn' 'out' 'cann' 'herr' 'earr' 'even'
                         (atlimit)
                 )
@@ -158,8 +160,8 @@ backwardmode (
 
     define Step_3 as (
         [substring] R1 among (
-            'tional'  (<- 'tion')
-            'ational' (<- 'ate')
+            'tional'  (<-'tion')
+            'ational' (<-'ate')
             'alize'   (<-'al')
             'icate' 'iciti' 'ical'
                       (<-'ic')
@@ -193,6 +195,7 @@ define exception1 as (
 
         /* special changes: */
 
+        'skis'      (<-'ski')
         'skies'     (<-'sky')
 
         /* special -LY cases */