Natools

Check-in [87228b7a84]
Login

Check-in [87228b7a84]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:s_expressions-conditionals-strings: add an equality test
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 87228b7a84f311cacda5df90d62c89fdbe319b9d
User & Date: nat 2017-06-17 19:33:47.099
Context
2017-06-18
21:35
s_expressions-conditionals-strings-tests: test the new equality test check-in: e21eaeef3f user: nat tags: trunk
2017-06-17
19:33
s_expressions-conditionals-strings: add an equality test check-in: 87228b7a84 user: nat tags: trunk
2017-06-16
21:17
tools/smaz: remove debug trace left over check-in: fe798b80fc user: nat tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to generated/natools-static_maps-s_expressions-conditionals-strings-p.adb. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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;






|


|


|

|
|










|
|

|




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

with Interfaces; use Interfaces;

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

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

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

   T2 : constant array (0 .. 2) of Unsigned_8 :=
     (14, 19, 16);

   G : constant array (0 .. 22) of Unsigned_8 :=
     (0, 0, 0, 9, 0, 0, 0, 0, 2, 0, 3, 0, 0, 3, 1, 0, 7, 0, 4, 0, 1, 7, 0);

   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 23;
         F2 := (F2 + Natural (T2 (K)) * J) mod 23;
      end loop;
      return (Natural (G (F1)) + Natural (G (F2))) mod 11;
   end Hash;

end Natools.Static_Maps.S_Expressions.Conditionals.Strings.P;
Changes to generated/natools-static_maps-s_expressions-conditionals-strings.ads. 
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32



33
34
35
36
37
38
39
40
41



42
43
44
45
46
47
48
49



50
51
52
53
54
55
56
57
58
59
60
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;

|











>



















|
>
>
>
|







|
>
>
>
|







>
>
>













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

--  Generated at 2017-06-17 18:23:38 +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,
      Is_Equal_To,
      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 := "is";
   Map_1_Key_8 : aliased constant String := "is-equal-to";
   Map_1_Key_9 : aliased constant String := "=";
   Map_1_Key_10 : aliased constant String := "starts-with";
   Map_1_Keys : constant array (0 .. 10) 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_Key_8'Access,
         Map_1_Key_9'Access,
         Map_1_Key_10'Access);
   Map_1_Elements : constant array (0 .. 10) of Parametric_Condition
     := (Case_Insensitive,
         Case_Sensitive,
         Contains_All,
         Contains_All,
         Contains_All,
         Contains_Any,
         Contains_Any,
         Is_Equal_To,
         Is_Equal_To,
         Is_Equal_To,
         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;
Changes to src/natools-s_expressions-conditionals-strings-maps.sx. 
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
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))))











>
















>










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

(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,
      Is_Equal_To,
      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)
         (Is_Equal_To   is is-equal-to "=")
         (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))))
Changes to src/natools-s_expressions-conditionals-strings.adb. 
1
2
3
4
5
6
7
8
9

------------------------------------------------------------------------------
-- 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         --


|








1
2
3
4
5
6
7
8
9

------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, 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         --
︙︙
32
33
34
35
36
37
38




39
40
41
42
43
44
45

      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;








>
>
>
>








32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

      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_Equal_To (Context : in Strings.Context; Data : in Atom)
     return Boolean;
      --  Check whether Context is equal to 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;
︙︙
91
92
93
94
95
96
97
















98
99
100
101
102
103
104

            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;








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

            Str_Value,
            Str_Value'First,
            Ada.Strings.Forward,
            Ada.Characters.Handling.To_Lower'Access) > 0;
      end if;
   end Contains;


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

      if Context.Settings.Case_Sensitive then
         return Context.Data.all = To_String (Data);
      else
         return Fixed.Translate (Context.Data.all, To_Lower'Access)
           = Fixed.Translate (To_String (Data), To_Lower'Access);
      end if;
   end Is_Equal_To;


   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;
︙︙
161
162
163
164
165
166
167




168
169
170
171
172
173
174

            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;










>
>
>
>








181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198

            return Conditional_On_Atoms
              (Context, Arguments, Contains'Access, True);

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

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

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