+2011-08-29 Ed Schonberg <schonberg@adacore.com>
+
+ * a-cbhama.adb, a-cbhama.ads, a-cborma.adb, a-cborma.ads, a-cobove.adb,
+ a-cobove.ads, a-coorma.adb, a-coorma.ads: Add iterator machinery to
+ container packages.
+
2011-08-29 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_util.adb, gnat1drv.adb, s-parint.ads: Minor
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
package body Ada.Containers.Bounded_Hashed_Maps is
+ type Iterator is new
+ Map_Iterator_Interfaces.Forward_Iterator with record
+ Container : Map_Access;
+ Node : Count_Type;
+ end record;
+
+ overriding function First (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------
-- Local Subprograms --
-----------------------
return Cursor'(Container'Unrestricted_Access, Node);
end First;
+ function First (Object : Iterator) return Cursor is
+ M : constant Map_Access := Object.Container;
+ N : constant Count_Type := HT_Ops.First (M.all);
+
+ begin
+ if N = 0 then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container.all'Unchecked_Access, N);
+ end First;
+
-----------------
-- Has_Element --
-----------------
B := B - 1;
end Iterate;
+ function Iterate
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ is
+ Node : constant Count_Type := HT_Ops.First (Container);
+ It : constant Iterator := (Container'Unrestricted_Access, Node);
+ begin
+ return It;
+ end Iterate;
+
---------
-- Key --
---------
Position := Next (Position);
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Node = 0 then
+ return No_Element;
+ else
+ return (Object.Container, Next (Position).Node);
+ end if;
+ end Next;
+
-------------------
-- Query_Element --
-------------------
raise Program_Error with "attempt to stream map cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Constant_Reference (Container : Map; Key : Key_Type)
+ return Constant_Reference_Type is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Constant_Reference;
+
+ function Reference (Container : Map; Key : Key_Type)
+ return Reference_Type is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Reference;
+
-------------
-- Replace --
-------------
raise Program_Error with "attempt to stream map cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Ada.Containers.Bounded_Hashed_Maps;
------------------------------------------------------------------------------
private with Ada.Containers.Hash_Tables;
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
generic
type Key_Type is private;
pragma Pure;
pragma Remote_Types;
- type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
+ type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private
+ with
+ Constant_Indexing => Constant_Reference,
+ Variable_Indexing => Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Map);
type Cursor is private;
-- Cursor objects declared without an initialization expression are
-- initialized to the value No_Element.
+ function Has_Element (Position : Cursor) return Boolean;
+ -- Equivalent to Position /= No_Element
+
+ package Map_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
+
function "=" (Left, Right : Map) return Boolean;
-- For each key/element pair in Left, equality attempts to find the key in
-- Right; if a search fails the equality returns False. The search works by
function Element (Container : Map; Key : Key_Type) return Element_Type;
-- Equivalent to Element (Find (Container, Key))
- function Has_Element (Position : Cursor) return Boolean;
- -- Equivalent to Position /= No_Element
-
function Equivalent_Keys (Left, Right : Cursor) return Boolean;
-- Returns the result of calling Equivalent_Keys with the keys of the nodes
-- designated by cursors Left and Right.
Process : not null access procedure (Position : Cursor));
-- Calls Process for each node in the map
+ function Iterate (Container : Map)
+ return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is
+ private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type);
+
+ for Constant_Reference_Type'Write use Write;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type);
+
+ for Constant_Reference_Type'Read use Read;
+
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type);
+
+ for Reference_Type'Write use Write;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type);
+
+ for Reference_Type'Read use Read;
+
+ function Constant_Reference
+ (Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
+ return Constant_Reference_Type;
+
+ function Reference (Container : Map; Key : Key_Type)
+ return Reference_Type;
+
private
-- pragma Inline ("=");
pragma Inline (Length);
pragma Inline (Capacity);
pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element);
- pragma Inline (Equivalent_Keys);
+ -- pragma Inline (Equivalent_Keys);
pragma Inline (Next);
type Node_Type is record
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
- use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
for Cursor'Write use Write;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ type Reference_Type
+ (Element : not null access Element_Type) is null record;
+
No_Element : constant Cursor := (Container => null, Node => 0);
Empty_Map : constant Map :=
package body Ada.Containers.Bounded_Ordered_Maps is
+ type Iterator is new
+ Map_Iterator_Interfaces.Reversible_Iterator with record
+ Container : Map_Access;
+ Node : Count_Type;
+ 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;
+
+ overriding function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------------
-- Node Access Subprograms --
-----------------------------
return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
+ function First (Object : Iterator) return Cursor is
+ F : constant Count_Type := Object.Container.First;
+ begin
+ if F = 0 then
+ return No_Element;
+ end if;
+
+ return
+ Cursor'(Object.Container.all'Unchecked_Access, F);
+ end First;
+
-------------------
-- First_Element --
-------------------
B := B - 1;
end Iterate;
+ function Iterate
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ is
+ It : constant Iterator :=
+ (Container'Unrestricted_Access, Container.First);
+ begin
+ return It;
+ end Iterate;
+
+ function Iterate (Container : Map; Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'class
+ is
+ It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
+ begin
+ return It;
+ end Iterate;
+
---------
-- Key --
---------
return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
+ function Last (Object : Iterator) return Cursor is
+ F : constant Count_Type := Object.Container.Last;
+ begin
+ if F = 0 then
+ return No_Element;
+ end if;
+
+ return
+ Cursor'(Object.Container.all'Unchecked_Access, F);
+ end Last;
+
------------------
-- Last_Element --
------------------
end;
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ pragma Unreferenced (Object);
+ begin
+ return Next (Position);
+ end Next;
+
------------
-- Parent --
------------
end;
end Previous;
+ function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ pragma Unreferenced (Object);
+ begin
+ return Previous (Position);
+ end Previous;
+
-------------------
-- Query_Element --
-------------------
raise Program_Error with "attempt to stream map cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Constant_Reference (Container : Map; Key : Key_Type)
+ return Constant_Reference_Type
+ is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Constant_Reference;
+
+ function Reference (Container : Map; Key : Key_Type)
+ return Reference_Type
+ is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Reference;
+
-------------
-- Replace --
-------------
raise Program_Error with "attempt to stream map cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Ada.Containers.Bounded_Ordered_Maps;
------------------------------------------------------------------------------
private with Ada.Containers.Red_Black_Trees;
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
generic
type Key_Type is private;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
- type Map (Capacity : Count_Type) is tagged private;
+ type Map (Capacity : Count_Type) is tagged private
+ with
+ constant_Indexing => Constant_Reference,
+ Variable_Indexing => Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Map);
type Cursor is private;
Empty_Map : constant Map;
No_Element : constant Cursor;
+ function Has_Element (Position : Cursor) return Boolean;
+
+ package Map_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
function "=" (Left, Right : Map) return Boolean;
function Contains (Container : Map; Key : Key_Type) return Boolean;
- function Has_Element (Position : Cursor) return Boolean;
-
function "<" (Left, Right : Cursor) return Boolean;
function ">" (Left, Right : Cursor) return Boolean;
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type);
+
+ for Constant_Reference_Type'Read use Read;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type);
+
+ for Constant_Reference_Type'Write use Write;
+
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type);
+
+ for Reference_Type'Read use Read;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type);
+
+ for Reference_Type'Write use Write;
+
+ function Constant_Reference
+ (Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
+ return Constant_Reference_Type;
+
+ function Reference (Container : Map; Key : Key_Type)
+ return Reference_Type;
+
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
+ function Iterate (Container : Map)
+ return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+ function Iterate (Container : Map; Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'class;
+
procedure Reverse_Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
use Red_Black_Trees;
use Tree_Types;
- use Ada.Streams;
type Cursor is record
Container : Map_Access;
for Map'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ type Reference_Type
+ (Element : not null access Element_Type) is null record;
+
Empty_Map : constant Map := Map'(Tree_Type with Capacity => 0);
end Ada.Containers.Bounded_Ordered_Maps;
package body Ada.Containers.Bounded_Vectors is
+ type Iterator is new
+ Vector_Iterator_Interfaces.Reversible_Iterator with record
+ Container : Vector_Access;
+ Index : Index_Type;
+ 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;
+
+ overriding function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------
-- Local Subprograms --
-----------------------
return (Container'Unrestricted_Access, Index_Type'First);
end First;
+ function First (Object : Iterator) return Cursor is
+ begin
+ if Is_Empty (Object.Container.all) then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container, Index_Type'First);
+ end First;
+
-------------------
-- First_Element --
-------------------
B := B - 1;
end Iterate;
+ function Iterate (Container : Vector)
+ return Vector_Iterator_Interfaces.Reversible_Iterator'Class
+ is
+ begin
+ return Iterator'(Container'Unrestricted_Access, Index_Type'First);
+ end Iterate;
+
+ function Iterate (Container : Vector; Start : Cursor)
+ return Vector_Iterator_Interfaces.Reversible_Iterator'class
+ is
+ begin
+ return Iterator'(Container'Unrestricted_Access, Start.Index);
+ end Iterate;
+
----------
-- Last --
----------
return (Container'Unrestricted_Access, Container.Last);
end Last;
+ function Last (Object : Iterator) return Cursor is
+ begin
+ if Is_Empty (Object.Container.all) then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container, Object.Container.Last);
+ end Last;
+
------------------
-- Last_Element --
------------------
return No_Element;
end Next;
- ----------
- -- Next --
- ----------
+ function Next (Object : Iterator; Position : Cursor) return Cursor is
+ begin
+ if Position.Index = Object.Container.Last then
+ return No_Element;
+ else
+ return (Object.Container, Position.Index + 1);
+ end if;
+ end Next;
procedure Next (Position : in out Cursor) is
begin
return No_Element;
end Previous;
+ function Previous (Object : Iterator; Position : Cursor) return Cursor is
+ begin
+ if Position.Index > Index_Type'First then
+ return (Object.Container, Position.Index - 1);
+ else
+ return No_Element;
+ end if;
+ end Previous;
+
-------------------
-- Query_Element --
-------------------
raise Program_Error with "attempt to stream vector cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Constant_Reference
+ (Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
+ return Constant_Reference_Type is
+ begin
+ pragma Unreferenced (Container);
+
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Index > Position.Container.Last then
+ raise Constraint_Error with "Position cursor is out of range";
+ end if;
+
+ return
+ (Element =>
+ Position.Container.Elements
+ (To_Array_Index (Position.Index))'Access);
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : Vector; Position : Index_Type)
+ return Constant_Reference_Type is
+ begin
+ if (Position) > Container.Last then
+ raise Constraint_Error with "Index is out of range";
+ end if;
+
+ return (Element =>
+ Container.Elements (To_Array_Index (Position))'Access);
+ end Constant_Reference;
+
+ function Reference (Container : Vector; Position : Cursor)
+ return Reference_Type is
+ begin
+ pragma Unreferenced (Container);
+
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Index > Position.Container.Last then
+ raise Constraint_Error with "Position cursor is out of range";
+ end if;
+
+ return
+ (Element =>
+ Position.Container.Elements
+ (To_Array_Index (Position.Index))'Access);
+ end Reference;
+
+ function Reference (Container : Vector; Position : Index_Type)
+ return Reference_Type is
+ begin
+ if Position > Container.Last then
+ raise Constraint_Error with "Index is out of range";
+ end if;
+
+ return (Element =>
+ Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
+ end Reference;
+
---------------------
-- Replace_Element --
---------------------
raise Program_Error with "attempt to stream vector cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Ada.Containers.Bounded_Vectors;
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
generic
type Index_Type is range <>;
No_Index : constant Extended_Index := Extended_Index'First;
- type Vector (Capacity : Count_Type) is tagged private;
+ type Vector (Capacity : Count_Type) is tagged private
+ with
+ Constant_Indexing => Constant_Reference,
+ Variable_Indexing => Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
+
pragma Preelaborable_Initialization (Vector);
type Cursor is private;
Empty_Vector : constant Vector;
No_Element : constant Cursor;
+ function Has_Element (Position : Cursor) return Boolean;
+
+ package Vector_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
overriding function "=" (Left, Right : Vector) return Boolean;
(Container : Vector;
Item : Element_Type) return Boolean;
- function Has_Element (Position : Cursor) return Boolean;
-
procedure Iterate
(Container : Vector;
Process : not null access procedure (Position : Cursor));
(Container : Vector;
Process : not null access procedure (Position : Cursor));
+ function Iterate (Container : Vector)
+ return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
+
+ function Iterate (Container : Vector; Start : Cursor)
+ return Vector_Iterator_Interfaces.Reversible_Iterator'class;
+
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is
+ private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type);
+
+ for Constant_Reference_Type'Read use Read;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type);
+
+ for Constant_Reference_Type'Write use Write;
+
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type);
+
+ for Reference_Type'Read use Read;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type);
+
+ for Reference_Type'Write use Write;
+
+ function Constant_Reference
+ (Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
+ return Constant_Reference_Type;
+
+ function Constant_Reference
+ (Container : Vector; Position : Index_Type)
+ return Constant_Reference_Type;
+
+ function Reference (Container : Vector; Position : Cursor)
+ return Reference_Type;
+
+ function Reference (Container : Vector; Position : Index_Type)
+ return Reference_Type;
+
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
pragma Inline (Next);
pragma Inline (Previous);
- type Elements_Array is array (Count_Type range <>) of Element_Type;
+ type Elements_Array is array (Count_Type range <>) of aliased Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Vector (Capacity : Count_Type) is tagged record
Lock : Natural := 0;
end record;
- use Ada.Streams;
-
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Vector);
for Cursor'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ type Reference_Type
+ (Element : not null access Element_Type) is null record;
+
Empty_Vector : constant Vector := (Capacity => 0, others => <>);
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
package body Ada.Containers.Ordered_Maps is
+ type Iterator is new
+ Map_Iterator_Interfaces.Reversible_Iterator with record
+ Container : Map_Access;
+ Node : Node_Access;
+ 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;
+
+ overriding function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------------
-- Node Access Subprograms --
-----------------------------
return Cursor'(Container'Unrestricted_Access, T.First);
end First;
+ function First (Object : Iterator) return Cursor is
+ M : constant Map_Access := Object.Container;
+ N : constant Node_Access := M.Tree.First;
+
+ begin
+ if N = null then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container.all'Unchecked_Access, N);
+ end First;
+
-------------------
-- First_Element --
-------------------
B := B - 1;
end Iterate;
+ function Iterate
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ is
+ Node : constant Node_Access := Container.Tree.First;
+ It : constant Iterator := (Container'Unrestricted_Access, Node);
+
+ begin
+ return It;
+ end Iterate;
+
+ function Iterate (Container : Map; Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'class
+ is
+ It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
+ begin
+ return It;
+ end Iterate;
+
---------
-- Key --
---------
return Cursor'(Container'Unrestricted_Access, T.Last);
end Last;
+ function Last (Object : Iterator) return Cursor is
+ M : constant Map_Access := Object.Container;
+ N : constant Node_Access := M.Tree.Last;
+
+ begin
+ if N = null then
+ return No_Element;
+ end if;
+
+ return Cursor'(Object.Container.all'Unchecked_Access, N);
+ end Last;
+
------------------
-- Last_Element --
------------------
end;
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Node = null then
+ return No_Element;
+ else
+ return (Object.Container, Tree_Operations.Next (Position.Node));
+ end if;
+ end Next;
+
------------
-- Parent --
------------
end;
end Previous;
+ function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+ if Position.Node = null then
+ return No_Element;
+ else
+ return (Object.Container, Tree_Operations.Previous (Position.Node));
+ end if;
+ end Previous;
-------------------
-- Query_Element --
-------------------
raise Program_Error with "attempt to stream map cursor";
end Read;
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Read;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Constant_Reference (Container : Map; Key : Key_Type)
+ return Constant_Reference_Type is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Constant_Reference;
+
+ function Reference (Container : Map; Key : Key_Type)
+ return Reference_Type is
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
+ end Reference;
+
-------------
-- Replace --
-------------
raise Program_Error with "attempt to stream map cursor";
end Write;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type)
+ is
+ begin
+ raise Program_Error with "attempt to stream reference";
+ end Write;
+
end Ada.Containers.Ordered_Maps;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
generic
type Key_Type is private;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
- type Map is tagged private;
- pragma Preelaborable_Initialization (Map);
+ type Map is tagged private
+ with
+ constant_Indexing => Constant_Reference,
+ Variable_Indexing => Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
Empty_Map : constant Map;
No_Element : constant Cursor;
+ function Has_Element (Position : Cursor) return Boolean;
+
+ package Map_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
function "=" (Left, Right : Map) return Boolean;
function Contains (Container : Map; Key : Key_Type) return Boolean;
- function Has_Element (Position : Cursor) return Boolean;
-
function "<" (Left, Right : Cursor) return Boolean;
function ">" (Left, Right : Cursor) return Boolean;
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type);
+
+ for Constant_Reference_Type'Read use Read;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type);
+
+ for Constant_Reference_Type'Write use Write;
+
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Reference_Type);
+
+ for Reference_Type'Read use Read;
+
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type);
+
+ for Reference_Type'Write use Write;
+
+ function Constant_Reference
+ (Container : Map; Key : Key_Type) -- SHOULD BE ALIASED
+ return Constant_Reference_Type;
+
+ function Reference (Container : Map; Key : Key_Type)
+ return Reference_Type;
+
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
+ function Iterate (Container : Map)
+ return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+ function Iterate (Container : Map; Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'class;
+
procedure Reverse_Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
- use Ada.Streams;
type Map_Access is access all Map;
for Map_Access'Storage_Size use 0;
for Map'Read use Read;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
+ type Reference_Type
+ (Element : not null access Element_Type) is null record;
+
Empty_Map : constant Map :=
(Controlled with Tree => (First => null,
Last => null,
Length => 0,
Busy => 0,
Lock => 0));
-
end Ada.Containers.Ordered_Maps;
OSDN Git Service
