===================================================================
@@ -219,6 +219,29 @@
pragma Warnings (On);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased List;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+
+ return (Element => Position.Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1277,31 +1300,22 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : List;
- Position : Cursor) return Constant_Reference_Type
+ function Reference
+ (Container : aliased in out List;
+ 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;
- return (Element => Position.Node.Element'Access);
- end Constant_Reference;
+ if Position.Container /= Container'Unchecked_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
- function Reference
- (Container : List;
- Position : Cursor) return Reference_Type
- is
- begin
- pragma Unreferenced (Container);
+ pragma Assert (Vet (Position), "bad cursor in function Reference");
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
return (Element => Position.Node.Element'Access);
end Reference;
===================================================================
@@ -90,6 +90,48 @@
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
+ 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 : aliased List;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out List;
+ Position : Cursor) return Reference_Type;
+
procedure Assign (Target : in out List; Source : List);
function Copy (Source : List) return List;
@@ -222,48 +264,6 @@
end Generic_Sorting;
- 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 : List; Position : Cursor) -- SHOULD BE ALIASED
- return Constant_Reference_Type;
-
- function Reference
- (Container : List; Position : Cursor) -- SHOULD BE ALIASED
- return Reference_Type;
-
private
pragma Inline (Next);
===================================================================
@@ -189,6 +189,55 @@
HT_Ops.Clear (Container.HT);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with
+ "Position cursor has no element";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element.all'Access);
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "key has no element";
+ end if;
+
+ return (Element => Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -955,31 +1004,49 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : Map;
- Key : Key_Type) return Constant_Reference_Type
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type
is
begin
- return (Element =>
- Container.Find (Key).Node.Element.all'Unrestricted_Access);
- end Constant_Reference;
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
- function Reference
- (Container : Map;
- Key : Key_Type) return Reference_Type
- is
- begin
- return (Element =>
- Container.Find (Key).Node.Element.all'Unrestricted_Access);
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with
+ "Position cursor has no element";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "Position cursor in function Reference is bad");
+
+ return (Element => Position.Node.Element.all'Access);
end Reference;
function Reference
(Container : aliased in out Map;
- Position : Cursor) return Reference_Type
+ Key : Key_Type) return Reference_Type
is
- pragma Unreferenced (Container);
+ Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
begin
- return (Element => Element (Position)'Unrestricted_Access);
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "key has no element";
+ end if;
+
+ return (Element => Node.Element.all'Access);
end Reference;
-------------
===================================================================
@@ -134,6 +134,55 @@
-- Calls Process with the key (with only a constant view) and element (with
-- a variable view) of the node designed by the cursor.
+ 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 : aliased Map;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type;
+
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
@@ -255,52 +304,6 @@
-- Returns the result of calling Equivalent_Keys with key Left and the node
-- designated by Right.
- 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;
-
- function Reference
- (Container : aliased in out Map;
- Position : Cursor) return Reference_Type;
-
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
===================================================================
@@ -673,34 +673,51 @@
------------------------
function Constant_Reference
- (Container : Vector;
+ (Container : aliased Vector;
Position : Cursor) return Constant_Reference_Type
is
+ E : Element_Access;
+
begin
- pragma Unreferenced (Container);
-
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with "Position cursor denotes wrong container";
+ 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.EA (Position.Index).all'Access);
+ E := Container.Elements.EA (Position.Index);
+
+ if E = null then
+ raise Constraint_Error with "element at Position is empty";
+ end if;
+
+ return (Element => E.all'Access);
end Constant_Reference;
function Constant_Reference
- (Container : Vector;
- Position : Index_Type) return Constant_Reference_Type
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_Reference_Type
is
+ E : Element_Access;
+
begin
- if (Position) > Container.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
- return (Element => Container.Elements.EA (Position).all'Access);
+ E := Container.Elements.EA (Index);
+
+ if E = null then
+ raise Constraint_Error with "element at Index is empty";
+ end if;
+
+ return (Element => E.all'Access);
end Constant_Reference;
--------------
@@ -2998,35 +3015,51 @@
---------------
function Reference
- (Container : Vector;
+ (Container : aliased in out Vector;
Position : Cursor) return Reference_Type
is
+ E : Element_Access;
+
begin
- pragma Unreferenced (Container);
-
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with "Position cursor denotes wrong container";
+ 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.EA (Position.Index).all'Access);
+ E := Container.Elements.EA (Position.Index);
+
+ if E = null then
+ raise Constraint_Error with "element at Position is empty";
+ end if;
+
+ return (Element => E.all'Access);
end Reference;
function Reference
- (Container : Vector;
- Position : Index_Type) return Reference_Type
+ (Container : aliased in out Vector;
+ Index : Index_Type) return Reference_Type
is
+ E : Element_Access;
+
begin
- if Position > Container.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
- return (Element => Container.Elements.EA (Position).all'Access);
+ E := Container.Elements.EA (Index);
+
+ if E = null then
+ raise Constraint_Error with "element at Index is empty";
+ end if;
+
+ return (Element => E.all'Access);
end Reference;
---------------------
===================================================================
@@ -150,19 +150,21 @@
for Reference_Type'Read use Read;
function Constant_Reference
- (Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
- return Constant_Reference_Type;
+ (Container : aliased Vector;
+ Position : Cursor) return Constant_Reference_Type;
+ function Reference
+ (Container : aliased in out Vector;
+ Position : Cursor) return Reference_Type;
+
function Constant_Reference
- (Container : Vector; Position : Index_Type)
- return Constant_Reference_Type;
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_Reference_Type;
- function Reference (Container : Vector; Position : Cursor)
- return Reference_Type;
+ function Reference
+ (Container : aliased in out Vector;
+ Index : Index_Type) return Reference_Type;
- function Reference (Container : Vector; Position : Index_Type)
- return Reference_Type;
-
function To_Cursor
(Container : Vector;
Index : Extended_Index) return Cursor;
===================================================================
@@ -372,6 +372,35 @@
return Node.Color;
end Color;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert
+ (Vet (Container.Tree, Position.Node),
+ "bad cursor in Constant_Reference");
+
+ return (Element => Position.Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -733,6 +762,29 @@
else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.Tree, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "Key not in set";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ return (Element => Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -889,6 +941,74 @@
Replace_Element (Container.Tree, Node, New_Item);
end Replace;
+ ----------
+ -- 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;
+
+ ------------------------------
+ -- Reference_Preserving_Key --
+ ------------------------------
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor) return Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert
+ (Vet (Container.Tree, Position.Node),
+ "bad cursor in function Reference_Preserving_Key");
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ return (Element => Position.Node.Element.all'Access);
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.Tree, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "Key not in set";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Key has not
+ -- changed. ???
+
+ return (Element => Node.Element.all'Access);
+ end Reference_Preserving_Key;
+
-----------------------------------
-- Update_Element_Preserving_Key --
-----------------------------------
@@ -955,42 +1075,10 @@
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Constant_Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
+ -----------
+ -- Write --
+ -----------
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Position.Node.Element);
- end Reference_Preserving_Key;
-
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
-
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Position.Node.Element);
- end Reference_Preserving_Key;
-
- 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 Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
@@ -1653,22 +1741,6 @@
raise Program_Error with "attempt to stream reference";
end Read;
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference (Container : Set; Position : Cursor)
- return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Position.Node.Element.all'Access);
- end Constant_Reference;
-
-------------
-- Replace --
-------------
===================================================================
@@ -67,27 +67,6 @@
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
- type Constant_Reference_Type
- (Element : not null access constant Element_Type) is
- private with
- Implicit_Dereference => Element;
-
- function Constant_Reference
- (Container : Set;
- Position : Cursor) return Constant_Reference_Type;
-
- 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;
-
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -111,6 +90,27 @@
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is
+ private with
+ Implicit_Dereference => Element;
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type;
+
+ 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;
+
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set) return Set;
@@ -292,6 +292,10 @@
function Reference_Preserving_Key
(Container : aliased in out Set;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
===================================================================
@@ -323,11 +323,38 @@
------------------------
function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert (Vet (Container.Tree, Position.Node),
+ "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element'Access);
+ end Constant_Reference;
+
+ function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
+ Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ return (Element => Node.Element'Access);
end Constant_Reference;
--------------
@@ -1250,14 +1277,40 @@
---------------
function Reference
- (Container : Map;
- Key : Key_Type)
- return Reference_Type
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type
is
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert (Vet (Container.Tree, Position.Node),
+ "Position cursor in function Reference is bad");
+
+ return (Element => Position.Node.Element'Access);
end Reference;
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ return (Element => Node.Element'Access);
+ end Reference;
+
-------------
-- Replace --
-------------
===================================================================
@@ -51,7 +51,7 @@
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private with
- constant_Indexing => Constant_Reference,
+ Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@@ -96,6 +96,31 @@
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type));
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type;
+
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map) return Map;
@@ -182,23 +207,6 @@
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;
-
- type Reference_Type (Element : not null access Element_Type) is private
- with
- Implicit_Dereference => Element;
-
- 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));
@@ -234,7 +242,7 @@
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Key : Key_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
end record;
package Tree_Types is
===================================================================
@@ -402,6 +402,53 @@
return Node.Color;
end Color;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert (Vet (Container, Position.Node),
+ "Position cursor in Constant_Reference is bad");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : Map;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Count_Type := Key_Ops.Find (Container, Key);
+
+ begin
+ if Node = 0 then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1318,20 +1365,47 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : Map;
- Key : Key_Type) return Constant_Reference_Type
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type
is
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
- end Constant_Reference;
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert (Vet (Container, Position.Node),
+ "Position cursor in function Reference is bad");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Reference;
+
function Reference
- (Container : Map;
+ (Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
+ Node : constant Count_Type := Key_Ops.Find (Container, Key);
+
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
+ if Node = 0 then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
end Reference;
-------------
===================================================================
@@ -50,7 +50,7 @@
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map (Capacity : Count_Type) is tagged private with
- constant_Indexing => Constant_Reference,
+ Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@@ -97,6 +97,55 @@
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type));
+ 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 : aliased Map;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type;
+
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
@@ -183,46 +232,6 @@
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));
@@ -251,7 +260,7 @@
Right : Count_Type;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Key : Key_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
end record;
package Tree_Types is
===================================================================
@@ -242,6 +242,33 @@
Free (X);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased List;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+
+ return (Element => Position.Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1303,27 +1330,26 @@
-- Reference --
---------------
- function Constant_Reference (Container : List; Position : Cursor)
- return Constant_Reference_Type is
+ function Reference
+ (Container : aliased in out List;
+ 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;
- return (Element => Position.Node.Element.all'Access);
- end Constant_Reference;
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
- function Reference (Container : List; Position : Cursor)
- return Reference_Type is
- begin
- pragma Unreferenced (Container);
-
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
end if;
+ pragma Assert (Vet (Position), "bad cursor in function Reference");
+
return (Element => Position.Node.Element.all'Access);
end Reference;
===================================================================
@@ -90,6 +90,48 @@
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
+ 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 : aliased List;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out List;
+ Position : Cursor) return Reference_Type;
+
procedure Assign (Target : in out List; Source : List);
function Copy (Source : List) return List;
@@ -203,50 +245,6 @@
Start : Cursor)
return List_Iterator_Interfaces.Reversible_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 : List;
- Position : Cursor) -- SHOULD BE ALIASED ???
- return Constant_Reference_Type;
-
- function Reference
- (Container : List;
- Position : Cursor) -- SHOULD BE ALIASED ???
- return Reference_Type;
-
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
===================================================================
@@ -441,6 +441,40 @@
pragma Assert (Children_Count = Container_Count);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Tree;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node = Root_Node (Container) then
+ raise Program_Error with "Position cursor designates root";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ -- Implement Vet for multiway tree???
+ -- pragma Assert (Vet (Position),
+ -- "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1980,24 +2014,34 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : aliased Tree;
- Position : Cursor) return Constant_Reference_Type
- is
- begin
- pragma Unreferenced (Container);
-
- return (Element => Position.Node.Element.all'Unchecked_Access);
- end Constant_Reference;
-
function Reference
- (Container : aliased Tree;
+ (Container : aliased in out Tree;
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;
- return (Element => Position.Node.Element.all'Unchecked_Access);
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node = Root_Node (Container) then
+ raise Program_Error with "Position cursor designates root";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ -- Implement Vet for multiway tree???
+ -- pragma Assert (Vet (Position),
+ -- "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element.all'Access);
end Reference;
--------------------
===================================================================
@@ -109,6 +109,14 @@
(Element : not null access Element_Type) is private
with Implicit_Dereference => Element;
+ function Constant_Reference
+ (Container : aliased Tree;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Tree;
+ Position : Cursor) return Reference_Type;
+
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree) return Tree;
@@ -400,14 +408,6 @@
for Reference_Type'Write use Write;
- function Constant_Reference
- (Container : aliased Tree;
- Position : Cursor) return Constant_Reference_Type;
-
- function Reference
- (Container : aliased Tree;
- Position : Cursor) return Reference_Type;
-
Empty_Tree : constant Tree := (Controlled with others => <>);
No_Element : constant Cursor := (others => <>);
===================================================================
@@ -204,6 +204,33 @@
HT_Ops.Clear (Container.HT);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+
+ return (Element => Position.Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1220,19 +1247,6 @@
raise;
end Read_Node;
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference
- (Container : aliased Set;
- Position : Cursor) return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- return (Element => Position.Node.Element.all'Access);
- end Constant_Reference;
-
-------------
-- Replace --
-------------
@@ -1892,6 +1906,29 @@
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.HT, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "Key not in set";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ return (Element => Node.Element.all'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -2001,6 +2038,74 @@
return Key (Position.Node.Element.all);
end Key;
+ ----------
+ -- 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;
+
+ ------------------------------
+ -- Reference_Preserving_Key --
+ ------------------------------
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor) return Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "bad cursor in function Reference_Preserving_Key");
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ return (Element => Position.Node.Element.all'Access);
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.HT, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "Key not in set";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Key has not
+ -- changed. ???
+
+ return (Element => Node.Element.all'Access);
+ end Reference_Preserving_Key;
+
-------------
-- Replace --
-------------
@@ -2022,6 +2127,10 @@
Replace_Element (Container.HT, Node, New_Item);
end Replace;
+ -----------------------------------
+ -- Update_Element_Preserving_Key --
+ -----------------------------------
+
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
@@ -2123,28 +2232,18 @@
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
- ------------------------------
- -- Reference_Preserving_Key --
- ------------------------------
+ -----------
+ -- Write --
+ -----------
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Position : Cursor) return Reference_Type
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
is
- pragma Unreferenced (Container);
begin
- return (Element => Position.Node.Element.all'Access);
- end Reference_Preserving_Key;
+ raise Program_Error with "attempt to stream reference";
+ end Write;
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
- begin
- return (Element => Position.Node.Element.all'Access);
- end Reference_Preserving_Key;
-
end Generic_Keys;
end Ada.Containers.Indefinite_Hashed_Sets;
===================================================================
@@ -150,8 +150,7 @@
function Constant_Reference
(Container : aliased Set;
- Position : Cursor)
- return Constant_Reference_Type;
+ Position : Cursor) return Constant_Reference_Type;
procedure Assign (Target : in out Set; Source : Set);
@@ -420,6 +419,10 @@
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type;
+
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type;
@@ -427,6 +430,20 @@
private
type Reference_Type (Element : not null access Element_Type)
is null record;
+
+ use Ada.Streams;
+
+ 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;
end Generic_Keys;
private
===================================================================
@@ -188,6 +188,46 @@
HT_Ops.Clear (Container.HT);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element'Access);
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ return (Element => Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -861,38 +901,40 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : aliased Map;
- Position : Cursor) return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- return (Element => Element (Position)'Unrestricted_Access);
- end Constant_Reference;
-
function Reference
(Container : aliased in out Map;
Position : Cursor) return Reference_Type
is
- pragma Unreferenced (Container);
begin
- return (Element => Element (Position)'Unrestricted_Access);
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "Position cursor in function Reference is bad");
+
+ return (Element => Position.Node.Element'Access);
end Reference;
- function Constant_Reference
- (Container : aliased Map;
- Key : Key_Type) return Constant_Reference_Type
- is
- begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
- end Constant_Reference;
-
function Reference
(Container : aliased in out Map;
Key : Key_Type) return Reference_Type
is
+ Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ return (Element => Node.Element'Access);
end Reference;
---------------
===================================================================
@@ -148,6 +148,55 @@
-- Calls Process with the key (with only a constant view) and element (with
-- a variable view) of the node designed by the cursor.
+ 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 : aliased Map;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type;
+
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
@@ -277,55 +326,6 @@
-- Returns the result of calling Equivalent_Keys with key Left and the node
-- designated by Right.
- 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 : aliased Map;
- Position : Cursor) return Constant_Reference_Type;
-
- function Reference
- (Container : aliased in out Map;
- Position : Cursor) return Reference_Type;
-
- function Constant_Reference
- (Container : aliased Map;
- Key : Key_Type) return Constant_Reference_Type;
-
- function Reference
- (Container : aliased in out Map;
- Key : Key_Type) return Reference_Type;
-
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
@@ -354,7 +354,7 @@
type Node_Type is limited record
Key : Key_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
Next : Node_Access;
end record;
===================================================================
@@ -331,6 +331,31 @@
return Node.Color;
end Color;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert
+ (Vet (Container.Tree, Position.Node),
+ "bad cursor in Constant_Reference");
+
+ return (Element => Position.Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -658,6 +683,25 @@
else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.Tree, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "key not in set";
+ end if;
+
+ return (Element => Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -784,6 +828,66 @@
return Key (Position.Node.Element);
end Key;
+ ----------
+ -- 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;
+
+ ------------------------------
+ -- Reference_Preserving_Key --
+ ------------------------------
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor) return Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert
+ (Vet (Container.Tree, Position.Node),
+ "bad cursor in function Reference_Preserving_Key");
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ return (Element => Position.Node.Element'Access);
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.Tree, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "key not in set";
+ end if;
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ return (Element => Node.Element'Access);
+ end Reference_Preserving_Key;
+
-------------
-- Replace --
-------------
@@ -867,42 +971,10 @@
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Constant_Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
+ -----------
+ -- Write --
+ -----------
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Position.Node.Element'Access);
- end Reference_Preserving_Key;
-
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
-
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Position.Node.Element'Access);
- end Reference_Preserving_Key;
-
- 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 Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
@@ -1536,22 +1608,6 @@
raise Program_Error with "attempt to stream reference";
end Read;
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference (Container : Set; Position : Cursor)
- return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Position.Node.Element'Access);
- end Constant_Reference;
-
-------------
-- Replace --
-------------
===================================================================
@@ -68,28 +68,6 @@
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
- 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;
-
- function Constant_Reference
- (Container : Set; Position : Cursor)
- return Constant_Reference_Type;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Constant_Reference_Type);
-
- for Constant_Reference_Type'Read use Read;
-
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -113,6 +91,28 @@
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
+ 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;
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type;
+
+ procedure Read
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : out Constant_Reference_Type);
+
+ for Constant_Reference_Type'Read use Read;
+
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set) return Set;
@@ -278,6 +278,10 @@
function Reference_Preserving_Key
(Container : aliased in out Set;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
===================================================================
@@ -190,6 +190,53 @@
HT_Ops.Clear (Container);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert (Vet (Position),
+ "Position cursor in Constant_Reference is bad");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : Map;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Count_Type := Key_Ops.Find (Container, Key);
+
+ begin
+ if Node = 0 then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -916,16 +963,47 @@
-- Reference --
---------------
- function Constant_Reference (Container : Map; Key : Key_Type)
- return Constant_Reference_Type is
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type
+ is
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
- end Constant_Reference;
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
- function Reference (Container : Map; Key : Key_Type)
- return Reference_Type is
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ pragma Assert (Vet (Position),
+ "Position cursor in function Reference is bad");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Reference;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Count_Type := Key_Ops.Find (Container, Key);
+
begin
- return (Element => Container.Element (Key)'Unrestricted_Access);
+ if Node = 0 then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
end Reference;
-------------
===================================================================
@@ -134,6 +134,56 @@
-- Calls Process with the key (with only a constant view) and element (with
-- a variable view) of the node designed by the cursor.
+ 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 : aliased Map;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type;
+
procedure Assign (Target : in out Map; Source : Map);
-- If Target denotes the same object as Source, then the operation has no
-- effect. If the Target capacity is less then the Source length, then
@@ -286,47 +336,6 @@
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 (Length);
pragma Inline (Is_Empty);
@@ -342,7 +351,7 @@
type Node_Type is record
Key : Key_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
Next : Count_Type;
end record;
===================================================================
@@ -402,6 +402,35 @@
return Node.Color;
end Color;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert
+ (Vet (Container, Position.Node),
+ "bad cursor in Constant_Reference");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -697,6 +726,28 @@
else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Count_Type := Key_Keys.Find (Container, Key);
+
+ begin
+ if Node = 0 then
+ raise Constraint_Error with "key not in set";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -822,6 +873,69 @@
return Key (Position.Container.Nodes (Position.Node).Element);
end Key;
+ ----------
+ -- 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;
+
+ ------------------------------
+ -- Reference_Preserving_Key --
+ ------------------------------
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor) return Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert
+ (Vet (Container, Position.Node),
+ "bad cursor in function Reference_Preserving_Key");
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Count_Type := Key_Keys.Find (Container, Key);
+
+ begin
+ if Node = 0 then
+ raise Constraint_Error with "key not in set";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Reference_Preserving_Key;
+
-------------
-- Replace --
-------------
@@ -900,46 +1014,10 @@
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Constant_Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
+ -----------
+ -- Write --
+ -----------
- begin
- if Position.Node = 0 then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return
- (Element =>
- Container.Nodes (Position.Node).Element'Unrestricted_Access);
- end Reference_Preserving_Key;
-
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
-
- begin
- if Position.Node = 0 then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return
- (Element =>
- Container.Nodes (Position.Node).Element'Unrestricted_Access);
- end Reference_Preserving_Key;
-
- 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 Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type)
@@ -1585,22 +1663,6 @@
raise Program_Error with "attempt to stream reference";
end Read;
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference (Container : Set; Position : Cursor)
- return Constant_Reference_Type
- is
- begin
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element =>
- Container.Nodes (Position.Node).Element'Unrestricted_Access);
- end Constant_Reference;
-
-------------
-- Replace --
-------------
===================================================================
@@ -65,16 +65,6 @@
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
- type Constant_Reference_Type
- (Element : not null access constant Element_Type) is
- private
- with
- Implicit_Dereference => Element;
-
- function Constant_Reference
- (Container : Set; Position : Cursor)
- return Constant_Reference_Type;
-
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -98,6 +88,16 @@
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is
+ private
+ with
+ Implicit_Dereference => Element;
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type;
+
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
@@ -263,6 +263,10 @@
function Reference_Preserving_Key
(Container : aliased in out Set;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type;
function Reference_Preserving_Key
@@ -297,7 +301,7 @@
Left : Count_Type;
Right : Count_Type;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
- Element : Element_Type;
+ Element : aliased Element_Type;
end record;
package Tree_Types is
===================================================================
@@ -437,6 +437,36 @@
pragma Assert (Children_Count = Container_Count);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Tree;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node = Root_Node (Container) then
+ raise Program_Error with "Position cursor designates root";
+ end if;
+
+ -- Implement Vet for multiway tree???
+ -- pragma Assert (Vet (Position),
+ -- "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -2000,24 +2030,30 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : aliased Tree;
- Position : Cursor) return Constant_Reference_Type
- is
- begin
- pragma Unreferenced (Container);
-
- return (Element => Position.Node.Element'Unrestricted_Access);
- end Constant_Reference;
-
function Reference
- (Container : aliased Tree;
+ (Container : aliased in out Tree;
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;
- return (Element => Position.Node.Element'Unrestricted_Access);
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node = Root_Node (Container) then
+ raise Program_Error with "Position cursor designates root";
+ end if;
+
+ -- Implement Vet for multiway tree???
+ -- pragma Assert (Vet (Position),
+ -- "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element'Access);
end Reference;
--------------------
===================================================================
@@ -108,6 +108,14 @@
(Element : not null access Element_Type) is private
with Implicit_Dereference => Element;
+ function Constant_Reference
+ (Container : aliased Tree;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Tree;
+ Position : Cursor) return Reference_Type;
+
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree) return Tree;
@@ -341,7 +349,7 @@
Prev : Tree_Node_Access;
Next : Tree_Node_Access;
Children : Children_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
end record;
pragma Convention (C, Tree_Node_Type);
@@ -445,14 +453,6 @@
for Reference_Type'Write use Write;
- function Constant_Reference
- (Container : aliased Tree;
- Position : Cursor) return Constant_Reference_Type;
-
- function Reference
- (Container : aliased Tree;
- Position : Cursor) return Reference_Type;
-
Empty_Tree : constant Tree := (Controlled with others => <>);
No_Element : constant Cursor := (others => <>);
===================================================================
@@ -358,12 +358,46 @@
------------------------
function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert (Vet (Container.Tree, Position.Node),
+ "Position cursor in Constant_Reference is bad");
+
+ return (Element => Position.Node.Element.all'Access);
+ end Constant_Reference;
+
+ function Constant_Reference
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
- Node : aliased Element_Type := Element (Container, Key);
+ Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
begin
- return (Element => Node'Access);
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ return (Element => Node.Element.all'Access);
end Constant_Reference;
--------------
@@ -1305,15 +1339,48 @@
---------------
function Reference
- (Container : Map;
- Key : Key_Type)
- return Reference_Type
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type
is
- Node : aliased Element_Type := Element (Container, Key);
begin
- return (Element => Node'Access);
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong map";
+ end if;
+
+ if Position.Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ pragma Assert (Vet (Container.Tree, Position.Node),
+ "Position cursor in function Reference is bad");
+
+ return (Element => Position.Node.Element.all'Access);
end Reference;
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "key not in map";
+ end if;
+
+ if Node.Element = null then
+ raise Program_Error with "Node has no element";
+ end if;
+
+ return (Element => Node.Element.all'Access);
+ end Reference;
+
-------------
-- Replace --
-------------
===================================================================
@@ -378,6 +378,52 @@
Container.Last := No_Index;
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Vector;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with "Position cursor denotes wrong container";
+ end if;
+
+ if Position.Index > Position.Container.Last then
+ raise Constraint_Error with "Position cursor is out of range";
+ end if;
+
+ declare
+ A : Elements_Array renames Container.Elements;
+ I : constant Count_Type := To_Array_Index (Position.Index);
+ begin
+ return (Element => A (I)'Access);
+ end;
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_Reference_Type
+ is
+ begin
+ if Index > Container.Last then
+ raise Constraint_Error with "Index is out of range";
+ end if;
+
+ declare
+ A : Elements_Array renames Container.Elements;
+ I : constant Count_Type := To_Array_Index (Index);
+ begin
+ return (Element => A (I)'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -2071,76 +2117,46 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : Vector;
- Position : Cursor) -- SHOULD BE ALIASED
- return Constant_Reference_Type
+ function Reference
+ (Container : aliased in out 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";
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with "Position cursor denotes wrong container";
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);
+ declare
+ A : Elements_Array renames Container.Elements;
+ I : constant Count_Type := To_Array_Index (Position.Index);
+ begin
+ return (Element => A (I)'Access);
+ end;
end Reference;
function Reference
- (Container : Vector;
- Position : Index_Type)
- return Reference_Type
+ (Container : aliased in out Vector;
+ Index : Index_Type) return Reference_Type
is
begin
- if Position > Container.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
- else
- return (Element =>
- Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
end if;
+
+ declare
+ A : Elements_Array renames Container.Elements;
+ I : constant Count_Type := To_Array_Index (Index);
+ begin
+ return (Element => A (I)'Access);
+ end;
end Reference;
---------------------
===================================================================
@@ -50,7 +50,7 @@
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private
- with constant_Indexing => Constant_Reference,
+ with Constant_Indexing => Constant_Reference,
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@@ -96,6 +96,31 @@
Process : not null access procedure (Key : Key_Type;
Element : in out Element_Type));
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ type Reference_Type (Element : not null access Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Map;
+ Key : Key_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Map;
+ Key : Key_Type) return Reference_Type;
+
procedure Assign (Target : in out Map; Source : Map);
function Copy (Source : Map) return Map;
@@ -176,23 +201,6 @@
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;
-
- type Reference_Type (Element : not null access Element_Type) is private
- with
- Implicit_Dereference => Element;
-
- function Constant_Reference
- (Container : Map;
- Key : Key_Type) 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));
===================================================================
@@ -142,6 +142,56 @@
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
+ 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 : aliased Vector;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Vector;
+ Position : Cursor) return Reference_Type;
+
+ function Constant_Reference
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Vector;
+ Index : Index_Type) return Reference_Type;
+
procedure Assign (Target : in out Vector; Source : Vector);
function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector;
@@ -308,54 +358,6 @@
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
===================================================================
@@ -478,6 +478,42 @@
end if;
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Vector;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with "Position cursor denotes wrong container";
+ end if;
+
+ if Position.Index > Position.Container.Last then
+ raise Constraint_Error with "Position cursor is out of range";
+ end if;
+
+ return (Element => Container.Elements.EA (Position.Index)'Access);
+ end Constant_Reference;
+
+ function Constant_Reference
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_Reference_Type
+ is
+ begin
+ if Index > Container.Last then
+ raise Constraint_Error with "Index is out of range";
+ else
+ return (Element => Container.Elements.EA (Index)'Access);
+ end if;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -2538,64 +2574,35 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : Vector;
- Position : Cursor) -- SHOULD BE ALIASED
- return Constant_Reference_Type
+ function Reference
+ (Container : aliased in out 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";
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with "Position cursor denotes wrong container";
end if;
- return
- (Element =>
- Position.Container.Elements.EA (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";
- else
- return (Element => Container.Elements.EA (Position)'Access);
- end if;
- 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.EA (Position.Index)'Access);
+ return (Element => Container.Elements.EA (Position.Index)'Access);
end Reference;
- function Reference (Container : Vector; Position : Index_Type)
- return Reference_Type is
+ function Reference
+ (Container : aliased in out Vector;
+ Index : Index_Type) return Reference_Type
+ is
begin
- if Position > Container.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
else
- return (Element => Container.Elements.EA (Position)'Access);
+ return (Element => Container.Elements.EA (Index)'Access);
end if;
end Reference;
===================================================================
@@ -189,19 +189,21 @@
for Reference_Type'Read use Read;
function Constant_Reference
- (Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
- return Constant_Reference_Type;
+ (Container : aliased Vector;
+ Position : Cursor) return Constant_Reference_Type;
+ function Reference
+ (Container : aliased in out Vector;
+ Position : Cursor) return Reference_Type;
+
function Constant_Reference
- (Container : Vector; Position : Index_Type)
- return Constant_Reference_Type;
+ (Container : aliased Vector;
+ Index : Index_Type) return Constant_Reference_Type;
- function Reference (Container : Vector; Position : Cursor)
- return Reference_Type;
+ function Reference
+ (Container : aliased in out Vector;
+ Index : Index_Type) return Reference_Type;
- function Reference (Container : Vector; Position : Index_Type)
- return Reference_Type;
-
procedure Assign (Target : in out Vector; Source : Vector);
function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector;
===================================================================
@@ -198,6 +198,29 @@
HT_Ops.Clear (Container.HT);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+
+ return (Element => Position.Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1126,19 +1149,6 @@
raise;
end Read_Node;
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference
- (Container : aliased Set;
- Position : Cursor) return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- return (Element => Position.Node.Element'Unrestricted_Access);
- end Constant_Reference;
-
-------------
-- Replace --
-------------
@@ -1720,6 +1730,25 @@
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.HT, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "Key not in set";
+ end if;
+
+ return (Element => Node.Element'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1831,6 +1860,66 @@
return Key (Position.Node.Element);
end Key;
+ ----------
+ -- 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;
+
+ ------------------------------
+ -- Reference_Preserving_Key --
+ ------------------------------
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor) return Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "bad cursor in function Reference_Preserving_Key");
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ return (Element => Position.Node.Element'Access);
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Node_Access :=
+ Key_Keys.Find (Container.HT, Key);
+
+ begin
+ if Node = null then
+ raise Constraint_Error with "Key not in set";
+ end if;
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Key has not
+ -- changed. ???
+
+ return (Element => Node.Element'Access);
+ end Reference_Preserving_Key;
+
-------------
-- Replace --
-------------
@@ -1952,27 +2041,18 @@
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
- ------------------------------
- -- Reference_Preserving_Key --
- ------------------------------
+ -----------
+ -- Write --
+ -----------
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Position : Cursor) return Reference_Type
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
is
- pragma Unreferenced (Container);
begin
- return (Element => Position.Node.Element'Unrestricted_Access);
- end Reference_Preserving_Key;
+ raise Program_Error with "attempt to stream reference";
+ end Write;
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
- begin
- return (Element => Position.Node.Element'Unrestricted_Access);
- end Reference_Preserving_Key;
end Generic_Keys;
end Ada.Containers.Hashed_Sets;
===================================================================
@@ -52,7 +52,7 @@
type Set is tagged private
with
- constant_Indexing => Constant_Reference,
+ Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
@@ -145,10 +145,6 @@
-- Calls Process with the element (having only a constant view) of the node
-- designed by the cursor.
- procedure Assign (Target : in out Set; Source : Set);
-
- function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
-
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with Implicit_Dereference => Element;
@@ -157,6 +153,10 @@
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
+ procedure Assign (Target : in out Set; Source : Set);
+
+ function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
+
procedure Move (Target : in out Set; Source : in out Set);
-- Clears Target (if it's not empty), and then moves (not copies) the
-- buckets array and nodes from Source to Target.
@@ -422,14 +422,32 @@
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type;
+
function Reference_Preserving_Key
(Container : aliased in out Set;
- Key : Key_Type) return Reference_Type;
+ Key : Key_Type) return Reference_Type;
private
type Reference_Type (Element : not null access Element_Type)
is null record;
+ use Ada.Streams;
+
+ 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;
+
end Generic_Keys;
private
@@ -439,7 +457,7 @@
type Node_Access is access Node_Type;
type Node_Type is limited record
- Element : Element_Type;
+ Element : aliased Element_Type;
Next : Node_Access;
end record;
===================================================================
@@ -296,6 +296,33 @@
Free (Container, X);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased List;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1537,34 +1564,27 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : List;
- Position : Cursor) return Constant_Reference_Type
+ function Reference
+ (Container : aliased in out List;
+ 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;
- return (Element =>
- Position.Container.Nodes (Position.Node).Element'Unrestricted_Access);
- end Constant_Reference;
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
- function Reference
- (Container : List;
- Position : Cursor) return Reference_Type
- is
- begin
- pragma Unreferenced (Container);
+ pragma Assert (Vet (Position), "bad cursor in function Reference");
- if Position.Container = null then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element =>
- Position.Container.Nodes (Position.Node).Element'Unrestricted_Access);
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
end Reference;
---------------------
===================================================================
@@ -88,6 +88,48 @@
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
+ 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 : aliased List;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out List;
+ Position : Cursor) return Reference_Type;
+
procedure Assign (Target : in out List; Source : List);
function Copy (Source : List; Capacity : Count_Type := 0) return List;
@@ -223,48 +265,6 @@
end Generic_Sorting;
- 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 : List; -- SHOULD BE ALIASED ???
- Position : Cursor) return Constant_Reference_Type;
-
- function Reference
- (Container : List; -- SHOULD BE ALIASED ???
- Position : Cursor) return Reference_Type;
-
private
pragma Inline (Next);
@@ -273,7 +273,7 @@
type Node_Type is record
Prev : Count_Type'Base;
Next : Count_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
end record;
type Node_Array is array (Count_Type range <>) of Node_Type;
===================================================================
@@ -588,6 +588,36 @@
pragma Assert (Count = Container_Count);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Tree;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node = Root_Node (Container) then
+ raise Program_Error with "Position cursor designates root";
+ end if;
+
+ -- Implement Vet for multiway tree???
+ -- pragma Assert (Vet (Position),
+ -- "Position cursor in Constant_Reference is bad");
+
+ return (Element => Container.Elements (Position.Node)'Access);
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -2464,26 +2494,30 @@
-- Reference --
---------------
- function Constant_Reference
- (Container : aliased Tree;
- Position : Cursor) return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- begin
- return
- (Element =>
- Position.Container.Elements (Position.Node)'Unchecked_Access);
- end Constant_Reference;
-
function Reference
- (Container : aliased Tree;
+ (Container : aliased in out Tree;
Position : Cursor) return Reference_Type
is
- pragma Unreferenced (Container);
begin
- return
- (Element =>
- Position.Container.Elements (Position.Node)'Unchecked_Access);
+ if Position.Container = null then
+ raise Constraint_Error with
+ "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ if Position.Node = Root_Node (Container) then
+ raise Program_Error with "Position cursor designates root";
+ end if;
+
+ -- Implement Vet for multiway tree???
+ -- pragma Assert (Vet (Position),
+ -- "Position cursor in Constant_Reference is bad");
+
+ return (Element => Container.Elements (Position.Node)'Access);
end Reference;
--------------------
===================================================================
@@ -107,6 +107,14 @@
(Element : not null access Element_Type) is private
with Implicit_Dereference => Element;
+ function Constant_Reference
+ (Container : aliased Tree;
+ Position : Cursor) return Constant_Reference_Type;
+
+ function Reference
+ (Container : aliased in out Tree;
+ Position : Cursor) return Reference_Type;
+
procedure Assign (Target : in out Tree; Source : Tree);
function Copy (Source : Tree; Capacity : Count_Type := 0) return Tree;
@@ -375,6 +383,7 @@
type Reference_Type
(Element : not null access Element_Type) is null record;
+
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type);
@@ -385,14 +394,6 @@
Item : out Reference_Type);
for Reference_Type'Read use Read;
- function Constant_Reference
- (Container : aliased Tree;
- Position : Cursor) return Constant_Reference_Type;
-
- function Reference
- (Container : aliased Tree;
- Position : Cursor) return Reference_Type;
-
Empty_Tree : constant Tree := (Capacity => 0, others => <>);
No_Element : constant Cursor := Cursor'(others => <>);
===================================================================
@@ -210,6 +210,33 @@
HT_Ops.Clear (Container);
end Clear;
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Position : Cursor) return Constant_Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1145,21 +1172,6 @@
raise Program_Error with "attempt to stream reference";
end Read;
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference
- (Container : aliased Set;
- Position : Cursor) return Constant_Reference_Type
- is
- pragma Unreferenced (Container);
- S : Set renames Position.Container.all;
- N : Node_Type renames S.Nodes (Position.Node);
- begin
- return (Element => N.Element'Unrestricted_Access);
- end Constant_Reference;
-
-------------
-- Replace --
-------------
@@ -1581,6 +1593,28 @@
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
+ ------------------------
+ -- Constant_Reference --
+ ------------------------
+
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type
+ is
+ Node : constant Count_Type := Key_Keys.Find (Container, Key);
+
+ begin
+ if Node = 0 then
+ raise Constraint_Error with "key not in set";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Constant_Reference;
+
--------------
-- Contains --
--------------
@@ -1686,6 +1720,69 @@
return Key (Position.Container.Nodes (Position.Node).Element);
end Key;
+ ----------
+ -- 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;
+
+ ------------------------------
+ -- Reference_Preserving_Key --
+ ------------------------------
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Position : Cursor) return Reference_Type
+ is
+ begin
+ if Position.Container = null then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ if Position.Container /= Container'Unrestricted_Access then
+ raise Program_Error with
+ "Position cursor designates wrong container";
+ end if;
+
+ pragma Assert
+ (Vet (Position),
+ "bad cursor in function Reference_Preserving_Key");
+
+ -- Some form of finalization will be required in order to actually
+ -- check that the key-part of the element designated by Position has
+ -- not changed. ???
+
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Reference_Preserving_Key;
+
+ function Reference_Preserving_Key
+ (Container : aliased in out Set;
+ Key : Key_Type) return Reference_Type
+ is
+ Node : constant Count_Type := Key_Keys.Find (Container, Key);
+
+ begin
+ if Node = 0 then
+ raise Constraint_Error with "key not in set";
+ end if;
+
+ declare
+ N : Node_Type renames Container.Nodes (Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end Reference_Preserving_Key;
+
-------------
-- Replace --
-------------
@@ -1806,29 +1903,18 @@
raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
- ------------------------------
- -- Reference_Preserving_Key --
- ------------------------------
+ -----------
+ -- Write --
+ -----------
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Position : Cursor) return Reference_Type
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Reference_Type)
is
- N : Node_Type renames Container.Nodes (Position.Node);
begin
- return (Element => N.Element'Unrestricted_Access);
- end Reference_Preserving_Key;
+ raise Program_Error with "attempt to stream reference";
+ end Write;
- function Reference_Preserving_Key
- (Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
- is
- Position : constant Cursor := Find (Container, Key);
- N : Node_Type renames Container.Nodes (Position.Node);
- begin
- return (Element => N.Element'Unrestricted_Access);
- end Reference_Preserving_Key;
-
end Generic_Keys;
end Ada.Containers.Bounded_Hashed_Sets;
===================================================================
@@ -433,6 +433,10 @@
(Container : aliased in out Set;
Position : Cursor) return Reference_Type;
+ function Constant_Reference
+ (Container : aliased Set;
+ Key : Key_Type) return Constant_Reference_Type;
+
function Reference_Preserving_Key
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type;
@@ -441,13 +445,27 @@
type Reference_Type (Element : not null access Element_Type)
is null record;
+ use Ada.Streams;
+
+ 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;
+
end Generic_Keys;
private
pragma Inline (Next);
type Node_Type is record
- Element : Element_Type;
+ Element : aliased Element_Type;
Next : Count_Type;
end record;