Natools

      - `Pools`: task-safe pool of referencesjj
  - `S-expressions`: library for dealing with [S-expressions][1]
      - `Atom_Buffers`: dynamic buffer for S-expression atoms
      - `Atom_Ref_Constructors`: helper constructors for atom references
      - `Atom_Refs`: common reference-counted atoms
      - `Conditionals`: S-expression boolean expressions about some object
          - `Generic_Evaluate`: Generic boolean expression evaluation framework
          - `Strings`: Boolean expressions on standard strings
      - `Dynamic_Interpreters`: S-expression interpreter with mutable
        commands and callbacks
      - `Encodings`: translators to and from official S-expression encodings
      - `File_Readers`: objects reading a file to an atom or a S-expression
      - `File_Writers`: file-backed S-expression printer
      - `Generic_Caches`: memory container for S-expressions
      - `Interpeter_Loop`: inner loop of S-expression interpreters,

with Interfaces; use Interfaces;

package body Natools.Static_Maps.S_Expressions.Conditionals.Strings.P is

   P : constant array (0 .. 2) of Natural :=
     (2, 11, 13);

   T1 : constant array (0 .. 2) of Unsigned_8 :=
     (9, 9, 0);

   T2 : constant array (0 .. 2) of Unsigned_8 :=
     (6, 4, 5);

   G : constant array (0 .. 16) of Unsigned_8 :=
     (0, 5, 0, 1, 0, 6, 0, 0, 7, 0, 0, 0, 0, 1, 1, 0, 3);

   function Hash (S : String) return Natural is
      F : constant Natural := S'First - 1;
      L : constant Natural := S'Length;
      F1, F2 : Natural := 0;
      J : Natural;
   begin
      for K in P'Range loop
         exit when L < P (K);
         J  := Character'Pos (S (P (K) + F));
         F1 := (F1 + Natural (T1 (K)) * J) mod 17;
         F2 := (F2 + Natural (T2 (K)) * J) mod 17;
      end loop;
      return (Natural (G (F1)) + Natural (G (F2))) mod 8;
   end Hash;

end Natools.Static_Maps.S_Expressions.Conditionals.Strings.P;

package Natools.Static_Maps.S_Expressions.Conditionals.Strings.P is
   pragma Pure;
   function Hash (S : String) return Natural;
end Natools.Static_Maps.S_Expressions.Conditionals.Strings.P;

with Interfaces; use Interfaces;

package body Natools.Static_Maps.S_Expressions.Conditionals.Strings.S is

   P : constant array (0 .. 0) of Natural :=
     (0 .. 0 => 4);

   T1 : constant array (0 .. 0) of Unsigned_8 :=
     (0 .. 0 => 4);

   T2 : constant array (0 .. 0) of Unsigned_8 :=
     (0 .. 0 => 3);

   G : constant array (0 .. 4) of Unsigned_8 :=
     (0, 0, 0, 0, 1);

   function Hash (S : String) return Natural is
      F : constant Natural := S'First - 1;
      L : constant Natural := S'Length;
      F1, F2 : Natural := 0;
      J : Natural;
   begin
      for K in P'Range loop
         exit when L < P (K);
         J  := Character'Pos (S (P (K) + F));
         F1 := (F1 + Natural (T1 (K)) * J) mod 5;
         F2 := (F2 + Natural (T2 (K)) * J) mod 5;
      end loop;
      return (Natural (G (F1)) + Natural (G (F2))) mod 2;
   end Hash;

end Natools.Static_Maps.S_Expressions.Conditionals.Strings.S;

package Natools.Static_Maps.S_Expressions.Conditionals.Strings.S is
   pragma Pure;
   function Hash (S : String) return Natural;
end Natools.Static_Maps.S_Expressions.Conditionals.Strings.S;

--  Generated at 2015-03-31 18:55:08 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-conditionals-strings-maps.sx

with Natools.Static_Maps.S_Expressions.Conditionals.Strings.P;
with Natools.Static_Maps.S_Expressions.Conditionals.Strings.S;
function Natools.Static_Maps.S_Expressions.Conditionals.Strings.T
  return Boolean is
begin
   for I in Map_1_Keys'Range loop
      if Natools.Static_Maps.S_Expressions.Conditionals.Strings.P.Hash
           (Map_1_Keys (I).all) /= I
      then
         return False;
      end if;
   end loop;

   for I in Map_2_Keys'Range loop
      if Natools.Static_Maps.S_Expressions.Conditionals.Strings.S.Hash
           (Map_2_Keys (I).all) /= I
      then
         return False;
      end if;
   end loop;

   return True;
end Natools.Static_Maps.S_Expressions.Conditionals.Strings.T;

--  Generated at 2015-03-31 18:55:08 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-conditionals-strings-maps.sx

function Natools.Static_Maps.S_Expressions.Conditionals.Strings.T
  return Boolean;
pragma Pure (Natools.Static_Maps.S_Expressions.Conditionals.Strings.T);

--  Generated at 2015-03-31 18:55:08 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-conditionals-strings-maps.sx

with Natools.Static_Maps.S_Expressions.Conditionals.Strings.P;
with Natools.Static_Maps.S_Expressions.Conditionals.Strings.S;

package body Natools.Static_Maps.S_Expressions.Conditionals.Strings is

   function To_Parametric (Key : String) return Parametric_Condition is
      N : constant Natural
        := Natools.Static_Maps.S_Expressions.Conditionals.Strings.P.Hash (Key);
   begin
      if Map_1_Keys (N).all = Key then
         return Map_1_Elements (N);
      else
         return Unknown_Parametric_Condition;
      end if;
   end To_Parametric;


   function To_Simple (Key : String) return Simple_Condition is
      N : constant Natural
        := Natools.Static_Maps.S_Expressions.Conditionals.Strings.S.Hash (Key);
   begin
      if Map_2_Keys (N).all = Key then
         return Map_2_Elements (N);
      else
         return Unknown_Simple_Condition;
      end if;
   end To_Simple;

end Natools.Static_Maps.S_Expressions.Conditionals.Strings;

--  Generated at 2015-03-31 18:55:08 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-conditionals-strings-maps.sx

package Natools.Static_Maps.S_Expressions.Conditionals.Strings is
   pragma Pure;

   type Parametric_Condition is
     (Unknown_Parametric_Condition,
      Case_Insensitive,
      Case_Sensitive,
      Contains_All,
      Contains_Any,
      Starts_With);

   type Simple_Condition is
     (Unknown_Simple_Condition,
      Is_ASCII,
      Is_Empty);

   function To_Parametric (Key : String) return Parametric_Condition;
   function To_Simple (Key : String) return Simple_Condition;

private

   Map_1_Key_0 : aliased constant String := "case-insensitive";
   Map_1_Key_1 : aliased constant String := "case-sensitive";
   Map_1_Key_2 : aliased constant String := "contains";
   Map_1_Key_3 : aliased constant String := "contains-all";
   Map_1_Key_4 : aliased constant String := "contains-all-of";
   Map_1_Key_5 : aliased constant String := "contains-any";
   Map_1_Key_6 : aliased constant String := "contains-any-of";
   Map_1_Key_7 : aliased constant String := "starts-with";
   Map_1_Keys : constant array (0 .. 7) of access constant String
     := (Map_1_Key_0'Access,
         Map_1_Key_1'Access,
         Map_1_Key_2'Access,
         Map_1_Key_3'Access,
         Map_1_Key_4'Access,
         Map_1_Key_5'Access,
         Map_1_Key_6'Access,
         Map_1_Key_7'Access);
   Map_1_Elements : constant array (0 .. 7) of Parametric_Condition
     := (Case_Insensitive,
         Case_Sensitive,
         Contains_All,
         Contains_All,
         Contains_All,
         Contains_Any,
         Contains_Any,
         Starts_With);

   Map_2_Key_0 : aliased constant String := "is-ascii";
   Map_2_Key_1 : aliased constant String := "is-empty";
   Map_2_Keys : constant array (0 .. 1) of access constant String
     := (Map_2_Key_0'Access,
         Map_2_Key_1'Access);
   Map_2_Elements : constant array (0 .. 1) of Simple_Condition
     := (Is_ASCII,
         Is_Empty);

end Natools.Static_Maps.S_Expressions.Conditionals.Strings;

(Natools.Static_Maps.S_Expressions.Conditionals.Strings
   pure
   (test-function T)
   (extra-decl "\
   type Parametric_Condition is
     (Unknown_Parametric_Condition,
      Case_Insensitive,
      Case_Sensitive,
      Contains_All,
      Contains_Any,
      Starts_With);

   type Simple_Condition is
     (Unknown_Simple_Condition,
      Is_ASCII,
      Is_Empty);")

   (Parametric_Condition
      (hash-package Natools.Static_Maps.S_Expressions.Conditionals.Strings.P)
      (function To_Parametric)
      (not-found Unknown_Parametric_Condition)
      (nodes
         (Case_Insensitive   case-insensitive)
         (Case_Sensitive   case-sensitive)
         (Contains_All   contains contains-all contains-all-of)
         (Contains_Any   contains-any contains-any-of)
         (Starts_With   starts-with)))

   (Simple_Condition
      (hash-package Natools.Static_Maps.S_Expressions.Conditionals.Strings.S)
      (function To_Simple)
      (not-found Unknown_Simple_Condition)
      (nodes
         (Is_ASCII   is-ascii)
         (Is_Empty   is-empty))))

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Natools.Static_Maps.S_Expressions.Conditionals.Strings;

package body Natools.S_Expressions.Conditionals.Strings is

   package Fixed renames Ada.Strings.Fixed;


   function Conditional_On_Atoms
     (Context : in Strings.Context;
      Arguments : in out Lockable.Descriptor'Class;
      Element : access function (Context : in Strings.Context;
                                 Data : in Atom)
                                return Boolean;
      Conjunction : in Boolean)
     return Boolean;
      --  Evaluate Element on all atoms of Arguments and combine them

   function Contains (Context : in Strings.Context; Data : in Atom)
     return Boolean;
      --  Check whether Context contains Data

   function Is_Prefix (Context : in Strings.Context; Data : in Atom)
     return Boolean;
      --  Check whether Context starts with Data

   function To_Lower (Item : in Character) return Character
     renames Ada.Characters.Handling.To_Lower;
      --  Clearer name for lower case translation, used for case-insentivity



   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Conditional_On_Atoms
     (Context : in Strings.Context;
      Arguments : in out Lockable.Descriptor'Class;
      Element : access function (Context : in Strings.Context;
                                 Data : in Atom)
                                return Boolean;
      Conjunction : in Boolean)
     return Boolean
   is
      Result : Boolean := not Conjunction;
      Event : Events.Event := Arguments.Current_Event;
   begin
      while Event = Events.Add_Atom loop
         Result := Element.all (Context, Arguments.Current_Atom);
         exit when Result /= Conjunction;
         Arguments.Next (Event);
      end loop;

      return Result;
   end Conditional_On_Atoms;


   function Contains (Context : in Strings.Context; Data : in Atom)
     return Boolean
   is
      Str_Value : String := To_String (Data);
   begin
      if Context.Settings.Case_Sensitive then
         return Fixed.Index
           (Context.Data.all,
            Str_Value,
            Str_Value'First,
            Ada.Strings.Forward) > 0;
      else
         Fixed.Translate (Str_Value, To_Lower'Access);
         return Fixed.Index
           (Context.Data.all,
            Str_Value,
            Str_Value'First,
            Ada.Strings.Forward,
            Ada.Characters.Handling.To_Lower'Access) > 0;
      end if;
   end Contains;


   function Is_Prefix (Context : in Strings.Context; Data : in Atom)
     return Boolean is
   begin
      if Context.Data.all'Length < Data'Length then
         return False;
      end if;

      declare
         Prefix : String renames Context.Data.all
           (Context.Data.all'First
            .. Context.Data.all'First + Data'Length - 1);
      begin
         if Context.Settings.Case_Sensitive then
            return Prefix = To_String (Data);
         else
            return Fixed.Translate (Prefix, To_Lower'Access)
              = Fixed.Translate (To_String (Data), To_Lower'Access);
         end if;
      end;
   end Is_Prefix;



   ---------------------------
   -- Evaluation Primitives --
   ---------------------------

   function Parametric_Evaluate
     (Context : in Strings.Context;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
     return Boolean
   is
      use Natools.Static_Maps.S_Expressions.Conditionals.Strings;
   begin
      case To_Parametric (To_String (Name)) is
         when Unknown_Parametric_Condition =>
            if Context.Parametric_Fallback /= null then
               return Context.Parametric_Fallback
                 (Context.Settings, Name, Arguments);
            else
               raise Constraint_Error with "Unknown parametric condition """
                 & To_String (Name) & '"';
            end if;

         when Case_Insensitive =>
            declare
               New_Context : Strings.Context := Context;
            begin
               New_Context.Settings.Case_Sensitive := False;
               return Evaluate (New_Context, Arguments);
            end;

         when Case_Sensitive =>
            declare
               New_Context : Strings.Context := Context;
            begin
               New_Context.Settings.Case_Sensitive := True;
               return Evaluate (New_Context, Arguments);
            end;

         when Contains_All =>
            return Conditional_On_Atoms
              (Context, Arguments, Contains'Access, True);

         when Contains_Any =>
            return Conditional_On_Atoms
              (Context, Arguments, Contains'Access, False);

         when Starts_With =>
            return Conditional_On_Atoms
              (Context, Arguments, Is_Prefix'Access, False);
      end case;
   end Parametric_Evaluate;


   function Simple_Evaluate
     (Context : in Strings.Context;
      Name : in Atom)
     return Boolean
   is
      use Natools.Static_Maps.S_Expressions.Conditionals.Strings;
   begin
      case To_Simple (To_String (Name)) is
         when Unknown_Simple_Condition =>
            if Context.Parametric_Fallback /= null then
               return Context.Simple_Fallback (Context.Settings, Name);
            else
               raise Constraint_Error with "Unknown simple condition """
                 & To_String (Name) & '"';
            end if;

         when Is_ASCII =>
            for I in Context.Data.all'Range loop
               if Context.Data (I)
                 not in Character'Val (0) .. Character'Val (127)
               then
                  return False;
               end if;
            end loop;
            return True;

         when Is_Empty =>
            return Context.Data.all'Length = 0;
      end case;
   end Simple_Evaluate;



   --------------------------
   -- Evaluation Shortcuts --
   --------------------------

   function Evaluate
     (Text : in String;
      Expression : in out Lockable.Descriptor'Class)
     return Boolean
   is
      Aliased_Text : aliased constant String := Text;
      Context : constant Strings.Context
        := (Data => Aliased_Text'Access,
            Parametric_Fallback => null,
            Simple_Fallback => null,
            Settings => <>);
   begin
      return Evaluate (Context, Expression);
   end Evaluate;

end Natools.S_Expressions.Conditionals.Strings;

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Conditionals.Strings provides primitives to        --
-- evaluate S-expression conditions about strings.                          --
------------------------------------------------------------------------------

with Natools.S_Expressions.Conditionals.Generic_Evaluate;
with Natools.S_Expressions.Lockable;

package Natools.S_Expressions.Conditionals.Strings is
   pragma Preelaborate;

   type Settings (Data : not null access constant String) is record
      Case_Sensitive : Boolean := True;
   end record;

   type Context
     (Data : not null access constant String;
      Parametric_Fallback : access function
        (Settings : in Strings.Settings;
         Name : in Atom;
         Arguments : in out Lockable.Descriptor'Class)
        return Boolean;
      Simple_Fallback : access function
        (Settings : in Strings.Settings;
         Name : in Atom)
        return Boolean)
   is record
      Settings : Strings.Settings (Data);
   end record;


   function Parametric_Evaluate
     (Context : in Strings.Context;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
     return Boolean;

   function Simple_Evaluate
     (Context : in Strings.Context;
      Name : in Atom)
     return Boolean;

   function Evaluate is new Generic_Evaluate
     (Context, Parametric_Evaluate, Simple_Evaluate);

   function Evaluate
     (Text : in String;
      Expression : in out Lockable.Descriptor'Class)
     return Boolean;

end Natools.S_Expressions.Conditionals.Strings;