if Container.Length = 0 then
pragma Assert (Container.First = 0);
pragma Assert (Container.Last = 0);
- pragma Assert (Container.Busy = 0);
- pragma Assert (Container.Lock = 0);
return;
end if;
pragma Assert (N (Container.First).Prev = 0);
pragma Assert (N (Container.Last).Next = 0);
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
while Container.Length > 1 loop
X := Container.First;
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
for Index in 1 .. Count loop
pragma Assert (Container.Length >= 2);
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
for J in 1 .. Count loop
X := Container.First;
pragma Assert (N (N (X).Next).Prev = Container.First);
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
for J in 1 .. Count loop
X := Container.Last;
pragma Assert (N (N (X).Prev).Next = Container.Last);
return Container.Nodes (Position.Node).Element;
end Element;
- --------------
- -- Finalize --
- --------------
-
- procedure Finalize (Object : in out Iterator) is
- begin
- if Object.Container /= null then
- declare
- B : Natural renames Object.Container.all.Busy;
- begin
- B := B - 1;
- end;
- end if;
- end Finalize;
-
----------
-- Find --
----------
return (Node => Container.First);
end First;
- function First (Object : Iterator) return Cursor is
- begin
- -- The value of the iterator object's Node component influences the
- -- behavior of the First (and Last) selector function.
-
- -- When the Node component is null, this means the iterator object was
- -- constructed without a start expression, in which case the (forward)
- -- iteration starts from the (logical) beginning of the entire sequence
- -- of items (corresponding to Container.First, for a forward iterator).
-
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Node component is non-null, the iterator object was constructed
- -- with a start expression, that specifies the position from which the
- -- (forward) partial iteration begins.
-
- if Object.Node = 0 then
- return First (Object.Container.all);
- else
- return (Node => Object.Node);
- end if;
- end First;
-
-------------------
-- First_Element --
-------------------
return;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Target (list is busy)";
- end if;
-
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
LI := First (Target);
RI := First (Source);
while RI.Node /= 0 loop
pragma Assert (N (Container.First).Prev = 0);
pragma Assert (N (Container.Last).Next = 0);
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
Sort (Front => 0, Back => 0);
pragma Assert (N (Container.First).Prev = 0);
raise Constraint_Error with "new length exceeds capacity";
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
Allocate (Container, New_Item, New_Node => J);
Insert_Internal (Container, Before.Node, New_Node => J);
Position := (Node => J);
raise Constraint_Error with "new length exceeds capacity";
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
Allocate (Container, New_Node => J);
Insert_Internal (Container, Before.Node, New_Node => J);
Position := (Node => J);
return Length (Container) = 0;
end Is_Empty;
- -------------
- -- Iterate --
- -------------
-
- procedure Iterate
- (Container : List;
- Process :
- not null access procedure (Container : List; Position : Cursor))
- is
- C : List renames Container'Unrestricted_Access.all;
- B : Natural renames C.Busy;
- Node : Count_Type;
-
- begin
- B := B + 1;
-
- begin
- Node := Container.First;
- while Node /= 0 loop
- Process (Container, (Node => Node));
- Node := Container.Nodes (Node).Next;
- end loop;
-
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Iterate;
-
- function Iterate (Container : List)
- return List_Iterator_Interfaces.Reversible_Iterator'Class
- is
- B : Natural renames Container'Unrestricted_Access.all.Busy;
-
- begin
- -- The value of the Node component influences the behavior of the First
- -- and Last selector functions of the iterator object. When the Node
- -- component is null (as is the case here), this means the iterator
- -- object was constructed without a start expression. This is a
- -- complete iterator, meaning that the iteration starts from the
- -- (logical) beginning of the sequence of items.
-
- -- Note: For a forward iterator, Container.First is the beginning, and
- -- for a reverse iterator, Container.Last is the beginning.
-
- return It : constant Iterator :=
- Iterator'(Ada.Finalization.Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => 0)
- do
- B := B + 1;
- end return;
- end Iterate;
-
- function Iterate (Container : List; Start : Cursor)
- return List_Iterator_Interfaces.Reversible_Iterator'Class
- is
- B : Natural renames Container'Unrestricted_Access.all.Busy;
-
- begin
- -- It was formerly the case that when Start = No_Element, the partial
- -- iterator was defined to behave the same as for a complete iterator,
- -- and iterate over the entire sequence of items. However, those
- -- semantics were unintuitive and arguably error-prone (it is too easy
- -- to accidentally create an endless loop), and so they were changed,
- -- per the ARG meeting in Denver on 2011/11. However, there was no
- -- consensus about what positive meaning this corner case should have,
- -- and so it was decided to simply raise an exception. This does imply,
- -- however, that it is not possible to use a partial iterator to specify
- -- an empty sequence of items.
-
- if not Has_Element (Container, Start) then
- raise Constraint_Error with
- "Start position for iterator is not a valid cursor";
- end if;
-
- -- The value of the Node component influences the behavior of the First
- -- and Last selector functions of the iterator object. When the Node
- -- component is non-null (as is the case here), it means that this
- -- is a partial iteration, over a subset of the complete sequence of
- -- items. The iterator object was constructed with a start expression,
- -- indicating the position from which the iteration begins. Note that
- -- the start position has the same value irrespective of whether this
- -- is a forward or reverse iteration.
-
- return It : constant Iterator :=
- Iterator'(Ada.Finalization.Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
- do
- B := B + 1;
- end return;
- end Iterate;
-
----------
-- Last --
----------
return (Node => Container.Last);
end Last;
- function Last (Object : Iterator) return Cursor is
- begin
- -- The value of the iterator object's Node component influences the
- -- behavior of the Last (and First) selector function.
-
- -- When the Node component is null, this means the iterator object was
- -- constructed without a start expression, in which case the (reverse)
- -- iteration starts from the (logical) beginning of the entire sequence
- -- (corresponding to Container.Last, for a reverse iterator).
-
- -- Otherwise, this is iteration over a partial sequence of items. When
- -- the Node component is non-null, the iterator object was constructed
- -- with a start expression, that specifies the position from which the
- -- (reverse) partial iteration begins.
-
- if Object.Node = 0 then
- return Last (Object.Container.all);
- else
- return (Node => Object.Node);
- end if;
- end Last;
-
------------------
-- Last_Element --
------------------
"Source length exceeds Target capacity";
end if;
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
Clear (Target);
while Source.Length > 1 loop
return (Node => Container.Nodes (Position.Node).Next);
end Next;
- function Next
- (Object : Iterator;
- Position : Cursor) return Cursor
- is
- begin
- return Next (Object.Container.all, Position);
- end Next;
-
- --------------------
- -- Not_No_Element --
- --------------------
-
- function Not_No_Element (Position : Cursor) return Boolean is
- begin
- return Position /= No_Element;
- end Not_No_Element;
-
-------------
-- Prepend --
-------------
return (Node => Container.Nodes (Position.Node).Prev);
end Previous;
- function Previous
- (Object : Iterator;
- Position : Cursor) return Cursor
- is
- begin
- return Previous (Object.Container.all, Position);
- end Previous;
-
- -------------------
- -- Query_Element --
- -------------------
-
- procedure Query_Element
- (Container : List; Position : Cursor;
- Process : not null access procedure (Element : Element_Type))
- is
- C : List renames Container'Unrestricted_Access.all;
- B : Natural renames C.Busy;
- L : Natural renames C.Lock;
-
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with
- "Position cursor has no element";
- end if;
-
- B := B + 1;
- L := L + 1;
-
- declare
- N : Node_Type renames C.Nodes (Position.Node);
- begin
- Process (N.Element);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end Query_Element;
-
- ----------
- -- Read --
- ----------
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out List)
- is
- N : Count_Type'Base;
-
- begin
- Clear (Item);
-
- Count_Type'Base'Read (Stream, N);
-
- if N < 0 then
- raise Program_Error with "bad list length";
- end if;
-
- if N = 0 then
- return;
- end if;
-
- if N > Item.Capacity then
- raise Constraint_Error with "length exceeds capacity";
- end if;
-
- for J in 1 .. N loop
- Item.Append (Element_Type'Input (Stream)); -- ???
- end loop;
- end Read;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor)
- is
- begin
- raise Program_Error with "attempt to stream list cursor";
- end Read;
-
- ---------------
- -- Reference --
- ---------------
-
- function Constant_Reference
- (Container : List;
- Position : Cursor) return Constant_Reference_Type
- is
- begin
- if not Has_Element (Container, Position) then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- return (Element => Container.Nodes (Position.Node).Element'Access);
- end Constant_Reference;
-
---------------------
-- Replace_Element --
---------------------
raise Constraint_Error with "Position cursor has no element";
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (list is locked)";
- end if;
-
pragma Assert
(Vet (Container, Position), "bad cursor in Replace_Element");
pragma Assert (N (Container.First).Prev = 0);
pragma Assert (N (Container.Last).Next = 0);
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
Container.First := J;
Container.Last := I;
loop
return No_Element;
end Reverse_Find;
- ---------------------
- -- Reverse_Iterate --
- ---------------------
-
- procedure Reverse_Iterate
- (Container : List;
- Process :
- not null access procedure (Container : List; Position : Cursor))
- is
- C : List renames Container'Unrestricted_Access.all;
- B : Natural renames C.Busy;
-
- Node : Count_Type;
-
- begin
- B := B + 1;
-
- begin
- Node := Container.Last;
- while Node /= 0 loop
- Process (Container, (Node => Node));
- Node := Container.Nodes (Node).Prev;
- end loop;
-
- exception
- when others =>
- B := B - 1;
- raise;
- end;
-
- B := B - 1;
- end Reverse_Iterate;
-
-----------
-- Right --
-----------
raise Constraint_Error;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Target (list is busy)";
- end if;
-
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
loop
Insert (Target, Before, SN (Source.Last).Element);
Delete_Last (Source);
raise Constraint_Error;
end if;
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Target (list is busy)";
- end if;
-
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
-
Insert
(Container => Target,
Before => Before,
pragma Assert (Container.Length >= 2);
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
if Before.Node = 0 then
pragma Assert (Position.Node /= Container.Last);
return;
end if;
- if Container.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (list is locked)";
- end if;
-
pragma Assert (Vet (Container, I), "bad I cursor in Swap");
pragma Assert (Vet (Container, J), "bad J cursor in Swap");
return;
end if;
- if Container.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with elements (list is busy)";
- end if;
-
pragma Assert (Vet (Container, I), "bad I cursor in Swap_Links");
pragma Assert (Vet (Container, J), "bad J cursor in Swap_Links");
end if;
end Swap_Links;
- --------------------
- -- Update_Element --
- --------------------
-
- procedure Update_Element
- (Container : in out List;
- Position : Cursor;
- Process : not null access procedure (Element : in out Element_Type))
- is
- begin
- if Position.Node = 0 then
- raise Constraint_Error with "Position cursor has no element";
- end if;
-
- pragma Assert
- (Vet (Container, Position), "bad cursor in Update_Element");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
-
- begin
- B := B + 1;
- L := L + 1;
-
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- begin
- Process (N.Element);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
-
- L := L - 1;
- B := B - 1;
- end;
- end Update_Element;
-
---------
-- Vet --
---------
return True;
end Vet;
- -----------
- -- Write --
- -----------
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : List)
- is
- N : Node_Array renames Item.Nodes;
- Node : Count_Type;
-
- begin
- Count_Type'Base'Write (Stream, Item.Length);
-
- Node := Item.First;
- while Node /= 0 loop
- Element_Type'Write (Stream, N (Node).Element);
- Node := N (Node).Next;
- end loop;
- end Write;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor)
- is
- begin
- raise Program_Error with "attempt to stream list cursor";
- end Write;
-
end Ada.Containers.Formal_Doubly_Linked_Lists;
-- See detailed specifications for these subprograms
-private with Ada.Streams;
-private with Ada.Finalization;
-with Ada.Iterator_Interfaces;
+-- private with Ada.Streams;
+-- private with Ada.Finalization;
+-- with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
package Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Pure;
- type List (Capacity : Count_Type) is tagged private with
- Constant_Indexing => Constant_Reference,
- Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
- -- pragma Preelaborable_Initialization (List);
+ type List (Capacity : Count_Type) is private;
+ pragma Preelaborable_Initialization (List);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
No_Element : constant Cursor;
- function Not_No_Element (Position : Cursor) return Boolean;
-
- package List_Iterator_Interfaces is new
- Ada.Iterator_Interfaces (Cursor => Cursor, Has_Element => Not_No_Element);
-
- function Iterate (Container : List; Start : Cursor)
- return List_Iterator_Interfaces.Reversible_Iterator'Class;
-
- function Iterate (Container : List)
- return List_Iterator_Interfaces.Reversible_Iterator'Class;
-
function "=" (Left, Right : List) return Boolean;
function Length (Container : List) return Count_Type;
Position : Cursor;
New_Item : Element_Type);
- procedure Query_Element
- (Container : List; Position : Cursor;
- Process : not null access procedure (Element : Element_Type));
-
- procedure Update_Element
- (Container : in out List;
- Position : Cursor;
- Process : not null access procedure (Element : in out Element_Type));
-
procedure Move (Target : in out List; Source : in out List);
procedure Insert
function Has_Element (Container : List; Position : Cursor) return Boolean;
- procedure Iterate
- (Container : List;
- Process :
- not null access procedure (Container : List; Position : Cursor));
-
- procedure Reverse_Iterate
- (Container : List;
- Process :
- not null access procedure (Container : List; Position : Cursor));
-
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
end Generic_Sorting;
- type Constant_Reference_Type
- (Element : not null access constant Element_Type) is private
- with
- Implicit_Dereference => Element;
-
- function Constant_Reference
- (Container : List; -- SHOULD BE ALIASED ???
- Position : Cursor) return Constant_Reference_Type;
-
function Strict_Equal (Left, Right : List) return Boolean;
-- Strict_Equal returns True if the containers are physically equal, i.e.
-- they are structurally equal (function "=" returns True) and that they
type Node_Type is record
Prev : Count_Type'Base := -1;
Next : Count_Type;
- Element : aliased Element_Type;
+ Element : Element_Type;
end record;
function "=" (L, R : Node_Type) return Boolean is abstract;
type List (Capacity : Count_Type) is tagged record
Nodes : Node_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1;
- Busy : Natural := 0;
- Lock : Natural := 0;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
end record;
- use Ada.Streams;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out List);
-
- for List'Read use Read;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : List);
-
- for List'Write use Write;
-
- type List_Access is access all List;
- for List_Access'Storage_Size use 0;
-
type Cursor is record
Node : Count_Type := 0;
end record;
- type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
-
- procedure Read
- (Stream : not null access Root_Stream_Type'Class;
- Item : out Cursor);
-
- for Cursor'Read use Read;
-
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Cursor);
-
- for Cursor'Write use Write;
-
Empty_List : constant List := (0, others => <>);
No_Element : constant Cursor := (Node => 0);
- use Ada.Finalization;
-
- type Iterator is new Limited_Controlled and
- List_Iterator_Interfaces.Reversible_Iterator with
- record
- Container : List_Access;
- Node : Count_Type;
- end record;
-
- overriding procedure Finalize (Object : in out Iterator);
-
- overriding function First (Object : Iterator) return Cursor;
- overriding function Last (Object : Iterator) return Cursor;
-
- overriding function Next
- (Object : Iterator;
- Position : Cursor) return Cursor;
-
- overriding function Previous
- (Object : Iterator;
- Position : Cursor) return Cursor;
-
end Ada.Containers.Formal_Doubly_Linked_Lists;
projects / thirdparty / gcc.git / commitdiff
