Natools

Check-in [ad65c67a84]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:static_hash_maps-s_expressions: new package to run static hash map generator using a S-expression description
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ad65c67a8409e0d37bd4a5165368adf4e60457c3
User & Date: nat on 2014-05-19 18:37:17
Other Links: manifest | tags
Context
2014-05-20
20:03
s_expressions-interpreter_loop: new generic procedure providing the main loop of a S-expression interpreter check-in: 654fe8f62b user: nat tags: trunk
2014-05-19
18:37
static_hash_maps-s_expressions: new package to run static hash map generator using a S-expression description check-in: ad65c67a84 user: nat tags: trunk
2014-05-18
20:20
static_hash_maps: new code generation package to build static hash maps

A static hash map means here a hash maps completely known before compile time. It uses GNAT.Perfect_Hash_Generator to turn string keys into indexes for an array of elements. check-in: 582f564b61 user: nat tags: trunk

Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added src/natools-static_hash_maps-s_expressions.adb version [b4bb055a3f]. 































































































































































































































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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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 Natools.S_Expressions.Interpreter_Loop;
with Natools.Static_Hash_Maps.S_Expressions.Command_Maps;

package body Natools.Static_Hash_Maps.S_Expressions is

   procedure Add_Map
     (Pkg : in out Map_Package;
      Context : in Meaningless_Type;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class);

   procedure Add_Value
     (Map : in out Map_Description;
      Element_Name : in String;
      Key : in Sx.Atom);

   procedure Generate_Package
     (Pkg : in out Map_Package;
      Description : in String;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class);

   procedure Update_Map
     (Map : in out Map_Description;
      Context : in Meaningless_Type;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class);

   procedure Update_Nodes
     (Map : in out Map_Description;
      Context : in Meaningless_Type;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class);

   procedure Update_Package
     (Pkg : in out Map_Package;
      Context : in Meaningless_Type;
      Name : in Sx.Atom);



   procedure Map_Interpreter is new Sx.Interpreter_Loop
     (Map_Description, Meaningless_Type, Update_Map);

   procedure Node_Interpreter is new Sx.Interpreter_Loop
     (Map_Description, Meaningless_Type, Update_Nodes);

   procedure Package_Generator is new Sx.Interpreter_Loop
     (Map_Package, String, Generate_Package);

   procedure Package_Interpreter is new Sx.Interpreter_Loop
     (Map_Package, Meaningless_Type, Add_Map, Update_Package);

   procedure Value_Interpreter is new Sx.Interpreter_Loop
     (Map_Description, String, Dispatch_Without_Argument => Add_Value);



   -------------------------
   -- Command Dispatchers --
   -------------------------

   procedure Add_Map
     (Pkg : in out Map_Package;
      Context : in Meaningless_Type;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Map : Map_Description;
   begin
      Set_Element_Type (Map, Sx.To_String (Name));
      Map_Interpreter (Arguments, Map, Meaningless_Value);
      Add_Map (Pkg, Map);
   end Add_Map;


   procedure Add_Value
     (Map : in out Map_Description;
      Element_Name : in String;
      Key : in Sx.Atom) is
   begin
      Insert (Map, Sx.To_String (Key), Element_Name);
   end Add_Value;


   procedure Generate_Package
     (Pkg : in out Map_Package;
      Description : in String;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class) is
   begin
      Open (Pkg, Sx.To_String (Name));
      Set_Description (Pkg, Description);
      Package_Interpreter (Arguments, Pkg, Meaningless_Value);
      Commit (Pkg);
   end Generate_Package;



   procedure Update_Map
     (Map : in out Map_Description;
      Context : in Meaningless_Type;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type Sx.Events.Event;
      Event : constant Sx.Events.Event := Arguments.Current_Event;
   begin
      case Command_Maps.To_Map_Command (Sx.To_String (Name)) is
         when Hash_Package =>
            if Event = Sx.Events.Add_Atom then
               Set_Hash_Package_Name
                 (Map, Sx.To_String (Arguments.Current_Atom));
            else
               Set_Hash_Package_Name (Map, "");
            end if;

         when Function_Name =>
            if Event = Sx.Events.Add_Atom then
               Set_Function_Name (Map, Sx.To_String (Arguments.Current_Atom));
            else
               Set_Function_Name (Map, "");
            end if;

         when Not_Found =>
            if Event = Sx.Events.Add_Atom then
               Set_Not_Found (Map, Sx.To_String (Arguments.Current_Atom));
            else
               Set_Not_Found (Map, "");
            end if;

         when Nodes =>
            Node_Interpreter (Arguments, Map, Meaningless_Value);
      end case;
   end Update_Map;


   procedure Update_Nodes
     (Map : in out Map_Description;
      Context : in Meaningless_Type;
      Name : in Sx.Atom;
      Arguments : in out Sx.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
   begin
      Value_Interpreter (Arguments, Map, Sx.To_String (Name));
   end Update_Nodes;


   procedure Update_Package
     (Pkg : in out Map_Package;
      Context : in Meaningless_Type;
      Name : in Sx.Atom)
   is
      pragma Unreferenced (Context);
   begin
      case Command_Maps.To_Package_Command (Sx.To_String (Name)) is
         when Private_Child =>
            Set_Private_Child (Pkg, True);
         when Public_Child =>
            Set_Private_Child (Pkg, False);
      end case;
   end Update_Package;



   -----------------------
   -- Public Generators --
   -----------------------

   procedure Generate_Packages
     (Input : in out Sx.Lockable.Descriptor'Class;
      Description : in String := "")
   is
      Pkg : Map_Package;
   begin
      Package_Generator (Input, Pkg, Description);
   end Generate_Packages;


   procedure Generate_Package
     (Input : in out Sx.Lockable.Descriptor'Class;
      Description : in String := "")
   is
      use type Sx.Events.Event;
      Pkg : Map_Package;
   begin
      if Input.Current_Event /= Sx.Events.Add_Atom then
         return;
      end if;

      declare
         Name : constant Sx.Atom := Input.Current_Atom;
         Event : Sx.Events.Event;
      begin
         Input.Next (Event);
         if Event = Sx.Events.Add_Atom or Event = Sx.Events.Open_List then
            Generate_Package (Pkg, Description, Name, Input);
         end if;
      end;
   end Generate_Package;

end Natools.Static_Hash_Maps.S_Expressions;








Added src/natools-static_hash_maps-s_expressions.ads version [d116c33d8f].























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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.Static_Hash_Maps.S_Expressions provides subprograms to read      --
-- S-expression descriptions of static hash maps and feed it to             --
-- Natools.Static_Hash_Maps.                                                --
------------------------------------------------------------------------------

with Natools.S_Expressions.Lockable;

package Natools.Static_Hash_Maps.S_Expressions is

   package Sx renames Natools.S_Expressions;

   procedure Generate_Packages
     (Input : in out Sx.Lockable.Descriptor'Class;
      Description : in String := "");
      --  Generate all hash map packages described in Input

   procedure Generate_Package
     (Input : in out Sx.Lockable.Descriptor'Class;
      Description : in String := "");
      --  Generate the package described by Input

private

   type Package_Command is
     (Private_Child,
      Public_Child);

   type Map_Command is
     (Hash_Package,
      Nodes,
      Function_Name,
      Not_Found);

end Natools.Static_Hash_Maps.S_Expressions;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47