Natools

Check-in [327414fdc7]
Login
Overview
Comment:constant_indefinite_ordered_maps: add Ada 2012 iterator and indexing interfaces
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 327414fdc7dfeedd54ab932a6b818e3354bdc59e
User & Date: nat on 2014-11-28 22:37:29
Other Links: manifest | tags
Context
2014-11-29
18:23
constant_indefinite_ordered_map_tests: add tests for the new indexing and iterator features check-in: 702a3d8ebc user: nat tags: trunk
2014-11-28
22:37
constant_indefinite_ordered_maps: add Ada 2012 iterator and indexing interfaces check-in: 327414fdc7 user: nat tags: trunk
2014-11-27
22:25
reference_tests: add a test for the implicit dereference check-in: 263f8e760e user: nat tags: trunk
Changes

Modified src/natools-constant_indefinite_ordered_maps.adb from [61be8f766a] to [d509c86522].

407
408
409
410
411
412
413










































414
415
416
417
418
419
420
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462







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









   procedure Clear (Container : in out Constant_Map) is
   begin
      Container.Backend.Reset;
   end Clear;

   function Constant_Reference
     (Container : aliased in Constant_Map;
      Position : in Cursor)
     return Constant_Reference_Type
   is
      use type Backend_Refs.Immutable_Reference;
   begin
      if Position.Is_Empty then
         raise Constraint_Error
           with "Constant_Reference called with empty Position";
      end if;

      if Container.Backend /= Position.Backend then
         raise Program_Error with "Constant_Reference called"
           & " with unrelated Container and Position";
      end if;

      return
        (Backend => Container.Backend,
         Element => Container.Backend.Query.Data.all.Nodes
                     (Position.Index).Element);
   end Constant_Reference;


   function Constant_Reference
     (Container : aliased in Constant_Map;
      Key : in Key_Type)
     return Constant_Reference_Type
   is
      Position : constant Cursor := Container.Find (Key);
   begin
      if Position.Is_Empty then
         raise Constraint_Error
           with "Constant_Reference called with Key not in map";
      end if;

      return
        (Backend => Container.Backend,
         Element => Container.Backend.Query.Data.Nodes
                     (Position.Index).Element);
   end Constant_Reference;


   function Contains (Container : Constant_Map; Key : Key_Type)
     return Boolean
   is
      Floor, Ceiling : Count_Type;
   begin
      if Container.Is_Empty then
512
513
514
515
516
517
518














519
520
521
522
523
524
525
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581







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








      for I in Container.Backend.Query.Data.Nodes'Range loop
         Position.Index := I;
         Process.all (Position);
      end loop;
   end Iterate;


   function Iterate (Container : in Constant_Map)
     return Map_Iterator_Interfaces.Reversible_Iterator'Class is
   begin
      return Iterator'(Backend => Container.Backend, Start => No_Element);
   end Iterate;


   function Iterate (Container : in Constant_Map; Start : in Cursor)
     return Map_Iterator_Interfaces.Reversible_Iterator'Class is
   begin
      return Iterator'(Backend => Container.Backend, Start => Start);
   end Iterate;


   function Last (Container : Constant_Map) return Cursor is
   begin
      if Container.Is_Empty then
         return No_Element;
      else
         return (Is_Empty => False,
581
582
583
584
585
586
587








































588
589
590
591
592
593
594
595
596
597
598
599
600
601

































602
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731







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














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

   end Reverse_Iterate;



   ------------------------------
   -- Updatable Map Operations --
   ------------------------------

   function Reference
     (Container : aliased in out Updatable_Map;
      Position : in Cursor)
     return Reference_Type
   is
      use type Backend_Refs.Immutable_Reference;
   begin
      if Position.Is_Empty then
         raise Constraint_Error with "Reference called with empty Position";
      end if;

      if Container.Backend /= Position.Backend then
         raise Program_Error
           with "Reference called with unrelated Container and Position";
      end if;

      return
        (Backend => Container.Backend,
         Element => Container.Backend.Query.Data.Nodes
                     (Position.Index).Element);
   end Reference;


   function Reference
     (Container : aliased in out Updatable_Map;
      Key : in Key_Type)
     return Reference_Type
   is
      Position : constant Cursor := Container.Find (Key);
   begin
      if Position.Is_Empty then
         raise Constraint_Error with "Reference called with Key not in map";
      end if;

      return
        (Backend => Container.Backend,
         Element => Container.Backend.Query.Data.Nodes
                     (Position.Index).Element);
   end Reference;

   procedure Update_Element
     (Container : in out Updatable_Map;
      Position : in Cursor;
      Process : not null access procedure (Key : in Key_Type;
                                           Element : in out Element_Type))
   is
      Accessor : constant Backend_Refs.Accessor := Position.Backend.Query;
   begin
      Process.all
        (Accessor.Data.Nodes (Position.Index).Key.all,
         Accessor.Data.Nodes (Position.Index).Element.all);
   end Update_Element;



   -------------------------
   -- Iterator Operations --
   -------------------------

   overriding function First (Object : Iterator) return Cursor is
   begin
      if Has_Element (Object.Start) then
         return Object.Start;
      elsif Object.Backend.Is_Empty then
         return No_Element;
      else
         return (Is_Empty => False,
            Backend => Object.Backend,
            Index => 1);
      end if;
   end First;


   overriding function Last (Object : Iterator) return Cursor is
   begin
      if Has_Element (Object.Start) then
         return Object.Start;
      elsif Object.Backend.Is_Empty then
         return No_Element;
      else
         return (Is_Empty => False,
            Backend => Object.Backend,
            Index => Object.Backend.Query.Data.Size);
      end if;
   end Last;

end Natools.Constant_Indefinite_Ordered_Maps;

Modified src/natools-constant_indefinite_ordered_maps.ads from [c93eb12364] to [6c929df40a].

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







+



















+







--                                                                          --
-- All the subprograms here have the semantics of standard indefinite       --
-- ordered maps (see ARM A.18.6), except for tampering, which becomes       --
-- irrelevant.                                                              --
------------------------------------------------------------------------------

with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Iterator_Interfaces;

private with Ada.Finalization;
private with Ada.Unchecked_Deallocation;
private with Natools.References;
private with Natools.Storage_Pools;

generic
   type Key_Type (<>) is private;
   type Element_Type (<>) is private;
   with function "<" (Left, Right : Key_Type) return Boolean is <>;
   with function "=" (Left, Right : Element_Type) return Boolean is <>;

package Natools.Constant_Indefinite_Ordered_Maps is
   pragma Preelaborate;

   package Unsafe_Maps is new Ada.Containers.Indefinite_Ordered_Maps
     (Key_Type, Element_Type);

   type Cursor is private;  --  with Type_Invariant => Is_Valid (Cursor);
   pragma Preelaborable_Initialization (Cursor);

   No_Element : constant Cursor;

   procedure Clear (Position : in out Cursor);
   function Is_Valid (Position : Cursor) return Boolean;

   function Has_Element (Position : Cursor) return Boolean;
104
105
106
107
108
109
110
111




112





113
114
115
116
117
118
119
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








+
+
+
+

+
+
+
+
+







   function ">" (Left : Cursor; Right : Key_Type) return Boolean
     with Pre => Has_Element (Left) or else raise Constraint_Error;
   function "<" (Left : Key_Type; Right : Cursor) return Boolean
     with Pre => Has_Element (Right) or else raise Constraint_Error;
   function ">" (Left : Key_Type; Right : Cursor) return Boolean
     with Pre => Has_Element (Right) or else raise Constraint_Error;


   package Map_Iterator_Interfaces is new Ada.Iterator_Interfaces
     (Cursor, Has_Element);


   type Constant_Map is tagged private;
--   TODO: add aspects when they don't put GNAT in an infinite loop
--   with Constant_Indexing => Constant_Reference,
--        Default_Iterator => Iterate,
--        Iterator_Element => Element_Type;
   pragma Preelaborable_Initialization (Constant_Map);

   procedure Clear (Container : in out Constant_Map);
   function Create (Source : Unsafe_Maps.Map) return Constant_Map;
   procedure Move (Target : in out Constant_Map; Source : in out Constant_Map);
   procedure Replace
     (Container : in out Constant_Map;
      New_Items : in Unsafe_Maps.Map);
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
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







+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+









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







     (Container : in Constant_Map;
      Process : not null access procedure (Position : in Cursor));

   procedure Reverse_Iterate
     (Container : in Constant_Map;
      Process : not null access procedure (Position : in Cursor));

   function Iterate (Container : in Constant_Map)
     return Map_Iterator_Interfaces.Reversible_Iterator'Class;

   function Iterate (Container : in Constant_Map; Start : in Cursor)
     return Map_Iterator_Interfaces.Reversible_Iterator'Class;


   type Constant_Reference_Type
     (Element : not null access constant Element_Type) is private
     with Implicit_Dereference => Element;

   function Constant_Reference
     (Container : aliased in Constant_Map;
      Position : in Cursor)
     return Constant_Reference_Type;

   function Constant_Reference
     (Container : aliased in Constant_Map;
      Key : in Key_Type)
     return Constant_Reference_Type;


   type Updatable_Map is new Constant_Map with private;
   type Updatable_Map is new Constant_Map with private
     with Constant_Indexing => Constant_Reference,
          Variable_Indexing => Reference,
          Default_Iterator => Iterate,
          Iterator_Element => Element_Type;
   pragma Preelaborable_Initialization (Updatable_Map);

   procedure Update_Element
     (Container : in out Updatable_Map;
      Position : in Cursor;
      Process : not null access procedure (Key : in Key_Type;
                                           Element : in out Element_Type))
     with Pre => (Has_Element (Position) or else raise Constraint_Error)
      and then (Is_Related (Container, Position) or else raise Program_Error);


   type Reference_Type (Element : not null access Element_Type) is private
     with Implicit_Dereference => Element;

   function Reference
     (Container : aliased in out Updatable_Map;
      Position : in Cursor)
     return Reference_Type;

   function Reference
     (Container : aliased in out Updatable_Map;
      Key : in Key_Type)
     return Reference_Type;


private

   type Key_Access is access Key_Type;
   type Element_Access is access Element_Type;

   type Node is record
254
255
256
257
258
259
260
261




































262
263
264
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








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




   function Has_Element (Position : Cursor) return Boolean
     is (not Position.Is_Empty);

   function Is_Related (Container : Constant_Map; Position : Cursor)
     return Boolean
     is (Backend_Refs."=" (Container.Backend, Position.Backend));


   type Constant_Reference_Type
     (Element : not null access constant Element_Type)
   is record
      Backend : Backend_Refs.Immutable_Reference;
   end record;


   type Reference_Type (Element : not null access Element_Type) is record
      Backend : Backend_Refs.Immutable_Reference;
   end record;


   type Iterator is new Map_Iterator_Interfaces.Reversible_Iterator with record
      Backend : Backend_Refs.Immutable_Reference;
      Start : Cursor := No_Element;
   end record;

   overriding function First (Object : Iterator) return Cursor;
   overriding function Last  (Object : Iterator) return Cursor;

   overriding function Next
     (Object   : Iterator;
      Position : Cursor) return Cursor
     is (Next (Position))
     with Pre => Position.Is_Empty
        or else Backend_Refs."=" (Position.Backend, Object.Backend);

   overriding function Previous
     (Object   : Iterator;
      Position : Cursor) return Cursor
     is (Previous (Position))
     with Pre => Position.Is_Empty
        or else Backend_Refs."=" (Position.Backend, Object.Backend);


   No_Element : constant Cursor := (Is_Empty => True);

end Natools.Constant_Indefinite_Ordered_Maps;