Natools

Check-in [bbcfe6dddf]
Login
Overview
Comment:s_expressions-interpreters: add constructor functions to make possible library-level constants
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: bbcfe6dddf4c41f87d6139856712d27e70af952f
User & Date: nat on 2014-05-16 17:48:51
Other Links: manifest | tags
Context
2014-05-17
14:09
s_expressions-interpreter_tests: use building functions in a test, to reach full coverage check-in: 17fe0bb70a user: nat tags: trunk
2014-05-16
17:48
s_expressions-interpreters: add constructor functions to make possible library-level constants check-in: bbcfe6dddf user: nat tags: trunk
2014-05-15
21:26
s_expressions-printers-pretty-config: update to match the new read-only interpreters check-in: e3c30c2e3d user: nat tags: trunk
Changes

Modified src/natools-s_expressions-interpreters.adb from [3c3c74e8b6] to [43b0b541fb].

265
266
267
268
269
270
271

















































272
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321







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

         end if;
      end if;

      raise Command_Not_Found
        with "Unknown command """ & To_String (Cmd.Current_Atom) & '"';
   end Execute;



   --------------------------------------
   -- Interpreter Building Subprograms --
   --------------------------------------

   function Build (Commands : Command_Array) return Interpreter is
      Result : Interpreter;
   begin
      for I in Commands'Range loop
         Result.Add_Command
           (Commands (I).Name.Query.Data.all,
            Commands (I).Cmd.Query.Data.all);
      end loop;

      return Result;
   end Build;


   function Build (Commands : Command_Array; Fallback : String)
     return Interpreter
   is
      Result : Interpreter := Build (Commands);
   begin
      Result.Set_Fallback (To_Atom (Fallback));
      return Result;
   end Build;


   function Item (Name : String; Cmd : Command'Class)
     return Command_Description
   is
      function Get_Name return Atom;
      function Get_Command return Command'Class;

      function Get_Name return Atom is
      begin
         return To_Atom (Name);
      end Get_Name;

      function Get_Command return Command'Class is
      begin
         return Cmd;
      end Get_Command;
   begin
      return (Name => Atom_Refs.Create (Get_Name'Access),
              Cmd => Command_Refs.Create (Get_Command'Access));
   end Item;

end Natools.S_Expressions.Interpreters;

Modified src/natools-s_expressions-interpreters.ads from [75ac7d4a0a] to [d8ed9e5354].

24
25
26
27
28
29
30

31

32
33
34
35
36
37
38
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40







+

+







-- Formal types represent common objets for all the command, Shared_State   --
-- begin read/write while Shared_Context is read-only.                      --
------------------------------------------------------------------------------

with Natools.S_Expressions.Lockable;

private with Ada.Containers.Indefinite_Ordered_Maps;
private with Natools.References;
private with Natools.S_Expressions.Atom_Refs;
private with Natools.Storage_Pools;

generic
   type Shared_State (<>) is limited private;
   type Shared_Context (<>) is limited private;

package Natools.S_Expressions.Interpreters is
   pragma Preelaborate (Interpreters);
111
112
113
114
115
116
117








118
119
120
121
122
123
124
125
126
127
128
129
130
131










132
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







+
+
+
+
+
+
+
+














+
+
+
+
+
+
+
+
+
+

   overriding procedure Execute
     (Self : in Interpreter;
      State : in out Shared_State;
      Context : in Shared_Context;
      Cmd : in out Lockable.Descriptor'Class);
      --  Execute a single command with arguments

   type Command_Description is private;
   type Command_Array is array (Positive range <>) of Command_Description;

   function Build (Commands : Command_Array) return Interpreter;
   function Build (Commands : Command_Array; Fallback : String)
     return Interpreter;
   function Item (Name : String; Cmd : Command'Class)
     return Command_Description;

private

   type Exception_Command is new Command with null record;

   package Command_Maps is new Ada.Containers.Indefinite_Ordered_Maps
     (Atom, Command'Class, Less_Than);

   type Interpreter is new Command with record
      Commands : Command_Maps.Map;
      Max_Length : Count := 0;
      Fallback_Name : Atom_Refs.Reference;
   end record;

   package Command_Refs is new Natools.References
     (Command'Class,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool);

   type Command_Description is record
      Name : Atom_Refs.Immutable_Reference;
      Cmd : Command_Refs.Immutable_Reference;
   end record;

end Natools.S_Expressions.Interpreters;