mittens 0.1.0

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

@@ -0,0 +1,219 @@
+-----------------------------------------------------------------------
+--  stemmer -- Multi-language stemmer with Snowball generator
+--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
+--  All rights reserved.
+--
+--  Redistribution and use in source and binary forms, with or without
+--  modification, are permitted provided that the following conditions
+--  are met:
+--
+--    1. Redistributions of source code must retain the above copyright notice,
+--       this list of conditions and the following disclaimer.
+--    2. Redistributions in binary form must reproduce the above copyright notice,
+--       this list of conditions and the following disclaimer in the documentation
+--       and/or other materials provided with the distribution.
+--    3. Neither the name of the Snowball project nor the names of its contributors
+--       may be used to endorse or promote products derived from this software
+--       without specific prior written permission.
+--
+--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+--  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+--  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+--  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+--  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+--  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+--  ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+--  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+--  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+-----------------------------------------------------------------------
+package Stemmer with SPARK_Mode is
+
+   pragma Preelaborate;
+
+   WORD_MAX_LENGTH : constant := 1024;
+
+   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;
+
+   --  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
+     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
+     Global => null,
+     Post => Get_Result'Result'Length < WORD_MAX_LENGTH;
+
+private
+
+   type Mask_Type is mod 2**32;
+
+   --  A 32-bit character value that was read from UTF-8 sequence.
+   --  A modular value is used because shift and logical arithmetic is necessary.
+   type Utf8_Type is mod 2**32;
+
+   --  Index of the Grouping_Array.  The index comes from the 32-bit character value
+   --  minus a starting offset.  We don't expect large tables and we check against
+   --  a maximum value.
+   subtype Grouping_Index is Utf8_Type range 0 .. 16384;
+
+   type Grouping_Array is array (Grouping_Index range <>) of Boolean with Pack;
+
+   subtype Among_Index is Natural range 0 .. 65535;
+   subtype Among_Start_Index is Among_Index range 1 .. Among_Index'Last;
+   subtype Operation_Index is Natural range 0 .. 65535;
+   subtype Result_Index is Integer range -1 .. WORD_MAX_LENGTH - 1;
+   subtype Char_Index is Result_Index range 0 .. Result_Index'Last;
+
+   type Among_Type is record
+      First       : Among_Start_Index;
+      Last        : Among_Index;
+      Substring_I : Integer;
+      Result      : Integer;
+      Operation   : Operation_Index;
+   end record;
+
+   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;
+
+   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 Find_Among (Context : in out Context_Type'Class;
+                         Amongs  : in Among_Array_Type;
+                         Pattern : in String;
+                         Execute : access procedure
+                           (Ctx       : in out Context_Type'Class;
+                            Operation : in Operation_Index;
+                            Status    : out Boolean);
+                         Result  : out Integer) with
+     Global => null,
+     Pre => Pattern'Length > 0 and Amongs'Length > 0;
+
+   procedure Find_Among_Backward (Context : in out Context_Type'Class;
+                                  Amongs  : in Among_Array_Type;
+                                  Pattern : in String;
+                                  Execute : access procedure
+                                    (Ctx       : in out Context_Type'Class;
+                                     Operation : in Operation_Index;
+                                     Status    : out Boolean);
+                                  Result  : out Integer) with
+     Global => null,
+     Pre => Pattern'Length > 0 and Amongs'Length > 0;
+
+   function Skip_Utf8 (Context : 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
+     Global => null;
+
+   function Skip_Utf8_Backward (Context : 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
+     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 (Context : in Context_Type'Class) return Natural;
+
+   function Length_Utf8 (Context : in Context_Type'Class) 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
+     Global => null,
+     Pre => C_Bra >= Context.Lb and C_Ket >= C_Bra and C_Ket <= Context.L;
+
+   procedure Slice_Del (Context : in out Context_Type'Class) with
+     Global => null,
+     Pre => Context.Bra >= Context.Lb and Context.Ket >= Context.Bra
+     and Context.Ket <= Context.L;
+
+   procedure Slice_From (Context : in out Context_Type'Class;
+                         Text    : in String) with
+     Global => null,
+     Pre => Context.Bra >= Context.Lb and Context.Ket >= Context.Bra
+     and Context.Ket <= Context.L
+     and Context.L - Context.Lb + Text'Length + Context.Ket - Context.Bra < Context.P'Length;
+
+   function Slice_To (Context : in Context_Type'Class) return String;
+
+   procedure Insert (Context : in out Context_Type'Class;
+                     C_Bra   : in Char_Index;
+                     C_Ket   : in Char_Index;
+                     S       : in String) with
+     Global => null,
+     Pre => C_Bra >= Context.Lb and C_Ket >= C_Bra and C_Ket <= Context.L;
+
+   --  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
+   --  cursor position ('C') or setup some markers from the cursor.
+   type Context_Type is abstract tagged record
+      C   : Char_Index := 0;
+      L   : Char_Index := 0;
+      Lb  : Char_Index := 0;
+      Bra : Char_Index := 0;
+      Ket : Char_Index := 0;
+      P   : String (1 .. WORD_MAX_LENGTH);
+   end record;
+
+end Stemmer;

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

@@ -0,0 +1,70 @@
+with Ada.Text_IO;
+with Ada.Command_Line;
+with Stemmer.Factory;
+procedure Stemwords is
+
+   use Stemmer.Factory;
+
+   function Get_Language (Name : in String) return Language_Type;
+   function Is_Space (C : in Character) return Boolean;
+
+   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
+   begin
+      return Language_Type'Value ("L_" & Name);
+
+   exception
+      when Constraint_Error =>
+         Ada.Text_IO.Put_Line ("Unsupported language: " & Name);
+         return L_ENGLISH;
+
+   end Get_Language;
+
+   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>");
+      return;
+   end if;
+   declare
+      Lang      : constant Language_Type := Get_Language (Ada.Command_Line.Argument (1));
+      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
+      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
+         declare
+            Line : constant String := Ada.Text_IO.Get_Line (Src_File);
+            Pos  : Positive := Line'First;
+            Last_Pos  : Positive;
+            Start_Pos : Positive;
+         begin
+            while Pos <= Line'Last loop
+               Last_Pos := Pos;
+               while Pos <= Line'Last and then Is_Space (Line (Pos)) loop
+                  Pos := Pos + 1;
+               end loop;
+               if Last_Pos < Pos then
+                  Ada.Text_IO.Put (Dst_File, Line (Last_Pos .. Pos - 1));
+               end if;
+               exit when Pos > Line'Last;
+               Start_Pos := Pos;
+               while Pos <= Line'Last and then not Is_Space (Line (Pos)) loop
+                  Pos := Pos + 1;
+               end loop;
+               Ada.Text_IO.Put (Dst_File, Stemmer.Factory.Stem (Lang, Line (Start_Pos .. Pos - 1)));
+            end loop;
+            Ada.Text_IO.New_Line (Dst_File);
+         end;
+      end loop;
+      Ada.Text_IO.Close (Src_File);
+      Ada.Text_IO.Close (Dst_File);
+   end;
+end Stemwords;

data/vendor/snowball/ada/stemmer_config.gpr

@@ -0,0 +1,83 @@
+abstract project Stemmer_Config is
+   for Source_Dirs use ();
+
+   type Yes_No is ("yes", "no");
+
+   type Library_Type_Type is ("relocatable", "static", "static-pic");
+
+   type Build_Type is ("distrib", "debug", "optimize", "profile", "coverage");
+   Mode : Build_Type := external ("BUILD", "distrib");
+
+   Processors := External ("PROCESSORS", "1");
+
+   package Builder is
+       case Mode is
+          when "debug" => 
+             for Default_Switches ("Ada") use ("-g", "-j" & Processors);
+          when others =>
+             for Default_Switches ("Ada") use ("-g", "-O3", "-j" & Processors);
+       end case;
+   end Builder;
+
+   package compiler is
+      warnings := ("-gnatwua");
+      defaults := ("-gnat2012");
+      case Mode is
+         when "distrib" =>
+            for Default_Switches ("Ada") use defaults & ("-gnatafno", "-gnatVa", "-gnatwa");
+
+         when "debug" =>
+            for Default_Switches ("Ada") use defaults & warnings
+               & ("-gnata", "-gnatVaMI", "-gnaty3abcefhiklmnprstxM99");
+
+         when "coverage" =>
+            for Default_Switches ("Ada") use defaults & warnings
+               & ("-gnata", "-gnatVaMI", "-gnaty3abcefhiklmnprstxM99",
+                  "-fprofile-arcs", "-ftest-coverage");
+
+         when "optimize" =>
+            for Default_Switches ("Ada") use defaults & warnings
+               & ("-gnatn", "-gnatp", "-fdata-sections", "-ffunction-sections");
+
+         when "profile" =>
+            for Default_Switches ("Ada") use defaults & warnings & ("-pg");
+
+      end case;
+   end compiler;
+
+   package binder is
+      case Mode is
+         when "debug" =>
+            for Default_Switches ("Ada") use ("-E");
+
+	 when others =>
+            for Default_Switches ("Ada") use ("-E");
+
+      end case;
+   end binder;
+
+   package linker is
+      case Mode is
+         when "profile" =>
+            for Default_Switches ("Ada") use ("-pg");
+
+         when "distrib" =>
+            for Default_Switches ("Ada") use ("-s");
+
+         when "optimize" =>
+            for Default_Switches ("Ada") use ("-Wl,--gc-sections");
+
+         when "coverage" =>
+            for Default_Switches ("ada") use ("-fprofile-arcs");
+	 
+	 when others =>
+	    null;
+      end case;
+
+   end linker;        
+ 
+   package Ide is
+      for VCS_Kind use "git";
+   end Ide;
+
+end Stemmer_Config;

data/vendor/snowball/ada/stemwords.gpr

@@ -0,0 +1,21 @@
+with "stemmer_config";
+project Stemwords is
+
+   Mains := ("stemwords.adb");
+
+   for Main use Mains;
+
+   for Source_Dirs use ("src", "algorithms");
+
+   for Object_Dir use "./" & Stemmer_Config'Object_Dir & "/obj";
+   for Exec_Dir use "./" & Stemmer_Config'Exec_Dir & "/bin";
+
+   package Binder renames Stemmer_Config.Binder;
+
+   package Builder renames Stemmer_Config.Builder;
+
+   package Compiler renames Stemmer_Config.Compiler;
+
+   package Linker renames Stemmer_Config.Linker;
+
+end Stemwords;