Natools

Check-in [447d5f633d]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:s_expressions-templates-generic_integers: new package for S-expression templates of integer values
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 447d5f633d6e703ff7934b57ad3f35c2c22f0174
User & Date: nat on 2014-09-14 21:33:19
Other Links: manifest | tags
Context
2014-09-15
20:04
s_expressions-atom_ref_constructors: new package containing helper constructors of atom references check-in: 146c8207c4 user: nat tags: trunk
2014-09-14
21:33
s_expressions-templates-generic_integers: new package for S-expression templates of integer values check-in: 447d5f633d user: nat tags: trunk
2014-09-13
14:03
s_expressions-printers: make level-checked Transfer go beyond the first list check-in: 7568f1efd7 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added generated/natools-static_maps-s_expressions-templates-integers-ac.adb version [2696fcb2be]. 


































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.Templates.Integers.AC is

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

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

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

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

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

end Natools.Static_Maps.S_Expressions.Templates.Integers.AC;








Added generated/natools-static_maps-s_expressions-templates-integers-ac.ads version [06975808b8].








1
2
3
4

+
+
+
+

package Natools.Static_Maps.S_Expressions.Templates.Integers.AC is
   pragma Pure;
   function Hash (S : String) return Natural;
end Natools.Static_Maps.S_Expressions.Templates.Integers.AC;








Added generated/natools-static_maps-s_expressions-templates-integers-mc.adb version [079f989c24].





































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

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

with Interfaces; use Interfaces;

package body Natools.Static_Maps.S_Expressions.Templates.Integers.MC is

   P : constant array (0 .. 3) of Natural :=
     (1, 2, 5, 9);

   T1 : constant array (0 .. 3) of Unsigned_8 :=
     (31, 27, 5, 36);

   T2 : constant array (0 .. 3) of Unsigned_8 :=
     (3, 33, 25, 27);

   G : constant array (0 .. 40) of Unsigned_8 :=
     (0, 0, 17, 16, 0, 17, 0, 0, 0, 0, 0, 12, 1, 12, 0, 7, 2, 9, 11, 4, 6,
      0, 17, 0, 0, 0, 0, 16, 5, 0, 1, 0, 0, 15, 0, 0, 0, 0, 13, 0, 7);

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

end Natools.Static_Maps.S_Expressions.Templates.Integers.MC;








Added generated/natools-static_maps-s_expressions-templates-integers-mc.ads version [fcf4889469].








1
2
3
4

+
+
+
+

package Natools.Static_Maps.S_Expressions.Templates.Integers.MC is
   pragma Pure;
   function Hash (S : String) return Natural;
end Natools.Static_Maps.S_Expressions.Templates.Integers.MC;








Added generated/natools-static_maps-s_expressions-templates-integers-t.adb version [1e73774a70].






























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

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

--  Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-templates-generic_integers-maps.sx

with Natools.Static_Maps.S_Expressions.Templates.Integers.MC;
with Natools.Static_Maps.S_Expressions.Templates.Integers.AC;
function Natools.Static_Maps.S_Expressions.Templates.Integers.T
  return Boolean is
begin
   for I in Map_1_Keys'Range loop
      if Natools.Static_Maps.S_Expressions.Templates.Integers.MC.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.Templates.Integers.AC.Hash
           (Map_2_Keys (I).all) /= I
      then
         return False;
      end if;
   end loop;

   return True;
end Natools.Static_Maps.S_Expressions.Templates.Integers.T;








Added generated/natools-static_maps-s_expressions-templates-integers-t.ads version [3769356ef6].










1
2
3
4
5
6

+
+
+
+
+
+

--  Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-templates-generic_integers-maps.sx

function Natools.Static_Maps.S_Expressions.Templates.Integers.T
  return Boolean;
pragma Pure (Natools.Static_Maps.S_Expressions.Templates.Integers.T);








Added generated/natools-static_maps-s_expressions-templates-integers.adb version [5ea69e5503].




































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

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

--  Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-templates-generic_integers-maps.sx

with Natools.Static_Maps.S_Expressions.Templates.Integers.MC;
with Natools.Static_Maps.S_Expressions.Templates.Integers.AC;

package body Natools.Static_Maps.S_Expressions.Templates.Integers is

   function Main (Key : String) return Main_Command is
      N : constant Natural
        := Natools.Static_Maps.S_Expressions.Templates.Integers.MC.Hash (Key);
   begin
      if Map_1_Keys (N).all = Key then
         return Map_1_Elements (N);
      else
         return Error;
      end if;
   end Main;


   function To_Align_Command (Key : String) return Align_Command is
      N : constant Natural
        := Natools.Static_Maps.S_Expressions.Templates.Integers.AC.Hash (Key);
   begin
      if Map_2_Keys (N).all = Key then
         return Map_2_Elements (N);
      else
         return Unknown_Align;
      end if;
   end To_Align_Command;

end Natools.Static_Maps.S_Expressions.Templates.Integers;








Added generated/natools-static_maps-s_expressions-templates-integers.ads version [6027c2bda4].












































































































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

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

--  Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps
--  from src/natools-s_expressions-templates-generic_integers-maps.sx

package Natools.Static_Maps.S_Expressions.Templates.Integers is
   pragma Pure;

   type Main_Command is
     (Error,
      Align,
      Align_Center,
      Align_Left,
      Align_Right,
      Base,
      Padding,
      Padding_Left,
      Padding_Right,
      Sign,
      Width,
      Width_Max,
      Width_Min);

   type Align_Command is (Unknown_Align, Set_Left, Set_Center, Set_Right);

   function Main (Key : String) return Main_Command;
   function To_Align_Command (Key : String) return Align_Command;

private

   Map_1_Key_0 : aliased constant String := "align";
   Map_1_Key_1 : aliased constant String := "align-center";
   Map_1_Key_2 : aliased constant String := "centered";
   Map_1_Key_3 : aliased constant String := "align-left";
   Map_1_Key_4 : aliased constant String := "left-align";
   Map_1_Key_5 : aliased constant String := "align-right";
   Map_1_Key_6 : aliased constant String := "right-align";
   Map_1_Key_7 : aliased constant String := "base";
   Map_1_Key_8 : aliased constant String := "padding";
   Map_1_Key_9 : aliased constant String := "padding-left";
   Map_1_Key_10 : aliased constant String := "left-padding";
   Map_1_Key_11 : aliased constant String := "padding-right";
   Map_1_Key_12 : aliased constant String := "right-padding";
   Map_1_Key_13 : aliased constant String := "sign";
   Map_1_Key_14 : aliased constant String := "signs";
   Map_1_Key_15 : aliased constant String := "width";
   Map_1_Key_16 : aliased constant String := "width-max";
   Map_1_Key_17 : aliased constant String := "max-width";
   Map_1_Key_18 : aliased constant String := "width-min";
   Map_1_Key_19 : aliased constant String := "min-width";
   Map_1_Keys : constant array (0 .. 19) 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_Key_11'Access,
         Map_1_Key_12'Access,
         Map_1_Key_13'Access,
         Map_1_Key_14'Access,
         Map_1_Key_15'Access,
         Map_1_Key_16'Access,
         Map_1_Key_17'Access,
         Map_1_Key_18'Access,
         Map_1_Key_19'Access);
   Map_1_Elements : constant array (0 .. 19) of Main_Command
     := (Align,
         Align_Center,
         Align_Center,
         Align_Left,
         Align_Left,
         Align_Right,
         Align_Right,
         Base,
         Padding,
         Padding_Left,
         Padding_Left,
         Padding_Right,
         Padding_Right,
         Sign,
         Sign,
         Width,
         Width_Max,
         Width_Max,
         Width_Min,
         Width_Min);

   Map_2_Key_0 : aliased constant String := "left";
   Map_2_Key_1 : aliased constant String := "center";
   Map_2_Key_2 : aliased constant String := "right";
   Map_2_Keys : constant array (0 .. 2) of access constant String
     := (Map_2_Key_0'Access,
         Map_2_Key_1'Access,
         Map_2_Key_2'Access);
   Map_2_Elements : constant array (0 .. 2) of Align_Command
     := (Set_Left,
         Set_Center,
         Set_Right);

end Natools.Static_Maps.S_Expressions.Templates.Integers;








Added src/natools-s_expressions-templates-generic_integers-maps.sx version [bb53337f82].


















































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

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

(Natools.Static_Maps.S_Expressions.Templates.Integers
   pure
   (test-function T)
   (extra-decl "\
   type Main_Command is
     (Error,
      Align,
      Align_Center,
      Align_Left,
      Align_Right,
      Base,
      Padding,
      Padding_Left,
      Padding_Right,
      Sign,
      Width,
      Width_Max,
      Width_Min);

   type Align_Command is (Unknown_Align, Set_Left, Set_Center, Set_Right);")

   (Main_Command
      (hash-package Natools.Static_Maps.S_Expressions.Templates.Integers.MC)
      (function Main)
      (not-found Error)
      (nodes
         (Align          align)
         (Align_Center   align-center centered)
         (Align_Left     align-left left-align)
         (Align_Right    align-right right-align)
         (Base           base)
         (Padding        padding)
         (Padding_Left   padding-left left-padding)
         (Padding_Right  padding-right right-padding)
         (Sign           sign signs)
         (Width          width)
         (Width_Max      width-max max-width)
         (Width_Min      width-min min-width)))
   (Align_Command
      (hash-package Natools.Static_Maps.S_Expressions.Templates.Integers.AC)
      (function To_Align_Command)
      (not-found Unknown_Align)
      (nodes
         (Set_Left   left)
         (Set_Center center)
         (Set_Right  right))))








Added src/natools-s_expressions-templates-generic_integers.adb version [b65cf1ae02].









































































































































































































































































































































































































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
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

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

------------------------------------------------------------------------------
-- 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.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.Static_Maps.S_Expressions.Templates.Integers;

package body Natools.S_Expressions.Templates.Generic_Integers is

   package Commands
     renames Natools.Static_Maps.S_Expressions.Templates.Integers;

   function Create (Data : Atom) return Atom_Refs.Immutable_Reference
     renames Atom_Ref_Constructors.Create;


   procedure Update_Format
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);


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

   procedure Update_Format
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Command : constant String := To_String (Name);
      Event : Events.Event;
   begin
      case Commands.Main (Command) is
         when Commands.Error =>
            null;

         when Commands.Align =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  case Commands.To_Align_Command
                    (To_String (Arguments.Current_Atom))
                  is
                     when Commands.Unknown_Align =>
                        null;
                     when Commands.Set_Left =>
                        State.Align := Left_Aligned;
                     when Commands.Set_Center =>
                        State.Align := Centered;
                     when Commands.Set_Right =>
                        State.Align := Right_Aligned;
                  end case;
               when others =>
                  null;
            end case;

         when Commands.Align_Center =>
            State.Align := Centered;

         when Commands.Align_Left =>
            State.Align := Left_Aligned;

         when Commands.Align_Right =>
            State.Align := Right_Aligned;

         when Commands.Base =>
            declare
               New_Base : constant Atom_Arrays.Immutable_Reference
                 := Create (Arguments);
            begin
               if not New_Base.Is_Empty
                 and then New_Base.Query.Data.all'Length >= 2
               then
                  State.Symbols := New_Base;
               end if;
            end;

         when Commands.Padding =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Left_Padding := Create (Arguments.Current_Atom);
                  State.Right_Padding := State.Left_Padding;
               when others =>
                  return;
            end case;

            Arguments.Next (Event);
            case Event is
               when Events.Add_Atom =>
                  State.Right_Padding := Create (Arguments.Current_Atom);
               when others =>
                  null;
            end case;

         when Commands.Padding_Left =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Left_Padding := Create (Arguments.Current_Atom);
               when others =>
                  null;
            end case;

         when Commands.Padding_Right =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Right_Padding := Create (Arguments.Current_Atom);
               when others =>
                  null;
            end case;

         when Commands.Sign =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Positive_Sign := Create (Arguments.Current_Atom);
               when others =>
                  return;
            end case;

            Arguments.Next (Event);
            case Event is
               when Events.Add_Atom =>
                  State.Negative_Sign := Create (Arguments.Current_Atom);
               when others =>
                  null;
            end case;

         when Commands.Width =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Maximum_Width
                    := Width'Value (To_String (Arguments.Current_Atom));
                  State.Minimum_Width := State.Maximum_Width;
               when others =>
                  return;
            end case;

            Arguments.Next (Event);
            case Event is
               when Events.Add_Atom =>
                  State.Maximum_Width
                    := Width'Value (To_String (Arguments.Current_Atom));
               when others =>
                  return;
            end case;

            Arguments.Next (Event);
            case Event is
               when Events.Add_Atom =>
                  State.Overflow_Message := Create (Arguments.Current_Atom);
               when others =>
                  return;
            end case;

         when Commands.Width_Max =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Maximum_Width
                    := Width'Value (To_String (Arguments.Current_Atom));
               when others =>
                  return;
            end case;

            Arguments.Next (Event);
            case Event is
               when Events.Add_Atom =>
                  State.Overflow_Message := Create (Arguments.Current_Atom);
               when others =>
                  return;
            end case;

         when Commands.Width_Min =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Minimum_Width
                    := Width'Value (To_String (Arguments.Current_Atom));
               when others =>
                  null;
            end case;
      end case;
   end Update_Format;


   procedure Interpreter is new Interpreter_Loop
     (Format, Meaningless_Type, Update_Format);



   -------------------------
   -- Dynamic Atom Arrays --
   -------------------------

   function Create (Atom_List : in out S_Expressions.Descriptor'Class)
     return Atom_Array
   is
      function Current_Atom return Atom is (Atom_List.Current_Atom);
      New_Ref : Atom_Refs.Immutable_Reference;
   begin
      case Atom_List.Current_Event is
         when Events.Add_Atom =>
            New_Ref := Atom_Refs.Create (Current_Atom'Access);
            Atom_List.Next;
            return (0 => New_Ref) & Create (Atom_List);

         when others =>
            return Atom_Array'(1 .. 0 => <>);
      end case;
   end Create;


   function Create (Atom_List : in out S_Expressions.Descriptor'Class)
     return Atom_Arrays.Immutable_Reference
   is
      function Create_Array return Atom_Array is (Create (Atom_List));
   begin
      return Atom_Arrays.Create (Create_Array'Access);
   end Create;


   function Decimal return Atom_Arrays.Immutable_Reference is
      function Create return Atom_Array
        is ((0 => Create ((1 => Character'Pos ('0'))),
             1 => Create ((1 => Character'Pos ('1'))),
             2 => Create ((1 => Character'Pos ('2'))),
             3 => Create ((1 => Character'Pos ('3'))),
             4 => Create ((1 => Character'Pos ('4'))),
             5 => Create ((1 => Character'Pos ('5'))),
             6 => Create ((1 => Character'Pos ('6'))),
             7 => Create ((1 => Character'Pos ('7'))),
             8 => Create ((1 => Character'Pos ('8'))),
             9 => Create ((1 => Character'Pos ('9')))));
   begin
      if Base_10.Is_Empty then
         Base_10 := Atom_Arrays.Create (Create'Access);
      end if;

      return Base_10;
   end Decimal;


   procedure Reverse_Render
     (Value : in Natural_T;
      Symbols : in Atom_Array;
      Output : in out Atom_Buffers.Atom_Buffer;
      Length : out Width)
   is
      Digit : Natural_T;
      Remainder : Natural_T := Value;
   begin
      Length := 0;
      loop
         Digit := Remainder mod Symbols'Length;
         Remainder := Remainder / Symbols'Length;
         Length := Length + 1;
         Output.Append (Symbols (Digit).Query.Data.all);
         exit when Remainder = 0;
      end loop;
   end Reverse_Render;



   ----------------------
   -- Public Interface --
   ----------------------

   function Render (Value : T; Template : Format) return Atom is
      function "*" (Count : Width; Symbol : Atom) return Atom;

      function Safe_Atom
        (Ref : Atom_Refs.Immutable_Reference;
         Fallback : String)
        return Atom;
--      The expression below seems to trigger an infinite loop in
--      GNAT-AUX 4.9.0 20140422, but the if-statement form doesn't.
--      is (if Ref.Is_Empty then To_Atom (Fallback) else Ref.Query.Data.all);

      function Safe_Atom
        (Ref : Atom_Refs.Immutable_Reference;
         Fallback : String)
        return Atom is
      begin
         if Ref.Is_Empty then
            return To_Atom (Fallback);
         else
            return Ref.Query.Data.all;
         end if;
      end Safe_Atom;

      function "*" (Count : Width; Symbol : Atom) return Atom is
         Result : Atom (1 .. Offset (Count) * Symbol'Length);
      begin
         for I in 0 .. Offset (Count) - 1 loop
            Result (I * Symbol'Length + 1 .. (I + 1) * Symbol'Length)
              := Symbol;
         end loop;

         return Result;
      end "*";

      Output : Atom_Buffers.Atom_Buffer;
      Has_Sign : Boolean := True;
      Length : Width;
      Symbols : constant Atom_Arrays.Immutable_Reference
        := (if Template.Symbols.Is_Empty then Decimal else Template.Symbols);
   begin
      if Value < 0 then
         Reverse_Render (-Value, Symbols.Query.Data.all, Output, Length);
         Output.Append (Safe_Atom (Template.Negative_Sign, "-"));
      else
         Reverse_Render (Value, Symbols.Query.Data.all, Output, Length);

         if not Template.Positive_Sign.Is_Empty then
            Output.Append (Template.Positive_Sign.Query.Data.all);
         else
            Has_Sign := False;
         end if;
      end if;

      Output.Invert;

      if Has_Sign then
         Length := Length + 1;
      end if;

      if Length > Template.Maximum_Width then
         return Safe_Atom (Template.Overflow_Message, "");
      end if;

      if Length < Template.Minimum_Width then
         declare
            Needed : constant Width := Template.Minimum_Width - Length;
            Left_Count, Right_Count : Width := 0;
         begin
            case Template.Align is
               when Left_Aligned =>
                  Right_Count := Needed;
               when Centered =>
                  Left_Count := Needed / 2;
                  Right_Count := Needed - Left_Count;
               when Right_Aligned =>
                  Left_Count := Needed;
            end case;

            return Left_Count * Safe_Atom (Template.Left_Padding, " ")
              & Output.Data
              & Right_Count * Safe_Atom (Template.Right_Padding, " ");
         end;
      end if;

      return Output.Data;
   end Render;


   procedure Parse
     (Template : in out Format;
      Expression : in out Lockable.Descriptor'Class) is
   begin
      Interpreter (Expression, Template, Meaningless_Value);
   end Parse;


   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in T)
   is
      Parsed_Template : Format;
   begin
      Parse (Parsed_Template, Template);
      Output.Write (Render (Value, Parsed_Template));
   end Render;

end Natools.S_Expressions.Templates.Generic_Integers;








Added src/natools-s_expressions-templates-generic_integers.ads version [013201ba5d].




























































































































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

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

------------------------------------------------------------------------------
-- 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.S_Expressions.Templates.Generic_Integers provides a template     --
-- interpreter for integer rendering.                                       --
-- The following commands are recognized:                                   --
--   (align "left|right|center")                                            --
--   (base "symbol 0" "symbol 1" "symbol 2" ...)                            --
--   (left-padding "symbol")                                                --
--   (max-width "max width" ["overflow text"])                              --
--   (min-width "min width")                                                --
--   (padding "left-symbol" "right-symbol")                                 --
--   (padding "symbol")                                                     --
--   (right-padding "symbol")                                               --
--   (sign "plus sign" ["minus sign"])                                      --
--   (width "fixed width")                                                  --
--   (width "min width" "max width" ["overflow text"])                      --
------------------------------------------------------------------------------

with Ada.Streams;
with Natools.References;
with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Lockable;
with Natools.Storage_Pools;

generic
   type T is range <>;
package Natools.S_Expressions.Templates.Generic_Integers is
   pragma Preelaborate;

   type Format is private;

   function Render (Value : T; Template : Format) return Atom;
      --  Render Value according to Template

   procedure Parse
     (Template : in out Format;
      Expression : in out Lockable.Descriptor'Class);
      --  Read Expression to fill Template

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in T);
      --  Read a rendering format from Template and use it on Value

private

   type Alignment is (Left_Aligned, Centered, Right_Aligned);
   type Width is range 0 .. 10000;

   subtype Base_T is T'Base;
   subtype Natural_T is Base_T range 0 .. Base_T'Last;


   type Atom_Array
     is array (Natural_T range <>) of Atom_Refs.Immutable_Reference;

   function Create (Atom_List : in out S_Expressions.Descriptor'Class)
     return Atom_Array;
      --  Build an array consisting of consecutive atoms found in Atom_List

   procedure Reverse_Render
     (Value : in Natural_T;
      Symbols : in Atom_Array;
      Output : in out Atom_Buffers.Atom_Buffer;
      Length : out Width)
     with Pre => Symbols'Length >= 2 and Symbols'First = 0;
      --  Create a little-endian image of Value using the given symbol table


   package Atom_Arrays is new References
     (Atom_Array,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool);

   function Create (Atom_List : in out S_Expressions.Descriptor'Class)
     return Atom_Arrays.Immutable_Reference;
      --  Build an array reference consisting of
      --  consecutive atoms found in Atom_List.

   function Decimal return Atom_Arrays.Immutable_Reference
     with Post => not Decimal'Result.Is_Empty;
      --  Return a reference to usual decimal representation

   Base_10 : Atom_Arrays.Immutable_Reference;
      --  Cache for the often-used decimal representation


   type Format is record
      Symbols : Atom_Arrays.Immutable_Reference;
      Positive_Sign : Atom_Refs.Immutable_Reference;
      Negative_Sign : Atom_Refs.Immutable_Reference;

      Minimum_Width : Width := 0;
      Align : Alignment := Right_Aligned;
      Left_Padding : Atom_Refs.Immutable_Reference;
      Right_Padding : Atom_Refs.Immutable_Reference;

      Maximum_Width : Width := Width'Last;
      Overflow_Message : Atom_Refs.Immutable_Reference;
   end record;


end Natools.S_Expressions.Templates.Generic_Integers;








Added src/natools-s_expressions-templates-integers.ads version [21caa052b4].






























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

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

------------------------------------------------------------------------------
-- 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.S_Expressions.Templates.Integers is a common instance of         --
-- Generic_Integers templates, instanciated for standard integers.          --
------------------------------------------------------------------------------

with Natools.S_Expressions.Templates.Generic_Integers;

package Natools.S_Expressions.Templates.Integers
  is new Natools.S_Expressions.Templates.Generic_Integers (Integer);
pragma Preelaborate (Natools.S_Expressions.Templates.Integers);








Added src/natools-s_expressions-templates.ads version [f7d4182442].





























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

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

------------------------------------------------------------------------------
-- 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.S_Expressions.Templates provides a common parent for all         --
-- packages belonging to S-expression templating system.                    --
------------------------------------------------------------------------------

package Natools.S_Expressions.Templates is
   pragma Pure;

end Natools.S_Expressions.Templates;








Added src/natools-static_maps-s_expressions-templates.ads version [624d6a5e96].





























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

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

------------------------------------------------------------------------------
-- 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_Maps.S_Expressions.Templates is a common parent to        --
-- generated static hash maps related to S-expression template system.      --
------------------------------------------------------------------------------

package Natools.Static_Maps.S_Expressions.Templates is
   pragma Pure;

end Natools.Static_Maps.S_Expressions.Templates;








Added src/natools-static_maps-s_expressions.ads version [2d2440894a].





























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

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

------------------------------------------------------------------------------
-- 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_Maps.S_Expressions is a common parent to generated static --
-- hash maps related to S-expressions.                                      --
------------------------------------------------------------------------------

package Natools.Static_Maps.S_Expressions is
   pragma Pure;

end Natools.Static_Maps.S_Expressions;








Added src/natools-static_maps.ads version [2104618a2b].






























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

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

------------------------------------------------------------------------------
-- 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_Maps is a common parent to generated static hash maps,    --
-- to put them out of their user hierarchy so that they can be categorized  --
-- pure and don't need to be recompiled when a parent change.               --
------------------------------------------------------------------------------

package Natools.Static_Maps is
   pragma Pure;

end Natools.Static_Maps;













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