Index: README.md ================================================================== --- README.md +++ README.md @@ -27,10 +27,11 @@ - `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 ADDED generated/natools-static_maps-s_expressions-conditionals-strings-p.adb Index: generated/natools-static_maps-s_expressions-conditionals-strings-p.adb ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings-p.adb +++ generated/natools-static_maps-s_expressions-conditionals-strings-p.adb @@ -0,0 +1,32 @@ +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; ADDED generated/natools-static_maps-s_expressions-conditionals-strings-p.ads Index: generated/natools-static_maps-s_expressions-conditionals-strings-p.ads ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings-p.ads +++ generated/natools-static_maps-s_expressions-conditionals-strings-p.ads @@ -0,0 +1,4 @@ +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; ADDED generated/natools-static_maps-s_expressions-conditionals-strings-s.adb Index: generated/natools-static_maps-s_expressions-conditionals-strings-s.adb ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings-s.adb +++ generated/natools-static_maps-s_expressions-conditionals-strings-s.adb @@ -0,0 +1,32 @@ +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; ADDED generated/natools-static_maps-s_expressions-conditionals-strings-s.ads Index: generated/natools-static_maps-s_expressions-conditionals-strings-s.ads ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings-s.ads +++ generated/natools-static_maps-s_expressions-conditionals-strings-s.ads @@ -0,0 +1,4 @@ +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; ADDED generated/natools-static_maps-s_expressions-conditionals-strings-t.adb Index: generated/natools-static_maps-s_expressions-conditionals-strings-t.adb ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings-t.adb +++ generated/natools-static_maps-s_expressions-conditionals-strings-t.adb @@ -0,0 +1,26 @@ +-- 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; ADDED generated/natools-static_maps-s_expressions-conditionals-strings-t.ads Index: generated/natools-static_maps-s_expressions-conditionals-strings-t.ads ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings-t.ads +++ generated/natools-static_maps-s_expressions-conditionals-strings-t.ads @@ -0,0 +1,6 @@ +-- 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); ADDED generated/natools-static_maps-s_expressions-conditionals-strings.adb Index: generated/natools-static_maps-s_expressions-conditionals-strings.adb ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings.adb +++ generated/natools-static_maps-s_expressions-conditionals-strings.adb @@ -0,0 +1,32 @@ +-- 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; ADDED generated/natools-static_maps-s_expressions-conditionals-strings.ads Index: generated/natools-static_maps-s_expressions-conditionals-strings.ads ================================================================== --- generated/natools-static_maps-s_expressions-conditionals-strings.ads +++ generated/natools-static_maps-s_expressions-conditionals-strings.ads @@ -0,0 +1,61 @@ +-- 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; ADDED src/natools-s_expressions-conditionals-strings-maps.sx Index: src/natools-s_expressions-conditionals-strings-maps.sx ================================================================== --- src/natools-s_expressions-conditionals-strings-maps.sx +++ src/natools-s_expressions-conditionals-strings-maps.sx @@ -0,0 +1,35 @@ +(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)))) ADDED src/natools-s_expressions-conditionals-strings.adb Index: src/natools-s_expressions-conditionals-strings.adb ================================================================== --- src/natools-s_expressions-conditionals-strings.adb +++ src/natools-s_expressions-conditionals-strings.adb @@ -0,0 +1,227 @@ +------------------------------------------------------------------------------ +-- 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; ADDED src/natools-s_expressions-conditionals-strings.ads Index: src/natools-s_expressions-conditionals-strings.ads ================================================================== --- src/natools-s_expressions-conditionals-strings.ads +++ src/natools-s_expressions-conditionals-strings.ads @@ -0,0 +1,67 @@ +------------------------------------------------------------------------------ +-- 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;