-- --
-- B o d y --
-- --
--- Copyright (C) 2010, Free Software Foundation, Inc. --
--- --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the contents of the part following the private keyword. --
+-- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
LN : constant Count_Type := Length (Left);
RN : constant Count_Type := Length (Right);
- RFst : Count_Type;
- RLst : Count_Type;
- LFst : Count_Type;
- LLst : Count_Type;
-
begin
-
- if Right.K = Plain then
- RFst := 1;
- RLst := RN;
- else
- RFst := Right.First;
- RLst := Right.First + RN - 1;
- end if;
-
- if Left.K = Plain then
- LFst := 1;
- LLst := LN;
- else
- LFst := Left.First;
- LLst := Left.First + LN - 1;
- end if;
-
if LN = 0 then
if RN = 0 then
return Empty_Vector;
declare
E : constant Elements_Array (1 .. Length (Right)) :=
- Right.Plain.Elements (RFst .. RLst);
+ Right.Elements (1 .. RN);
begin
- return (Length (Right),
- new Plain_Vector'(Length (Right), E,
- Last => Right.Plain.Last, others => <>),
- others => <>);
+ return (Length (Right), E, Last => Right.Last, others => <>);
end;
end if;
if RN = 0 then
declare
E : constant Elements_Array (1 .. Length (Left)) :=
- Left.Plain.Elements (LFst .. LLst);
+ Left.Elements (1 .. LN);
begin
- return (Length (Left),
- new Plain_Vector'(Length (Left), E,
- Last => Left.Plain.Last, others => <>),
- others => <>);
+ return (Length (Left), E, Last => Left.Last, others => <>);
end;
-
end if;
declare
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
- LE : constant Elements_Array (1 .. Length (Left)) :=
- Left.Plain.Elements (LFst .. LLst);
-
- RE : Elements_Array renames Right.Plain.Elements (RFst .. RLst);
+ LE : constant Elements_Array (1 .. LN) := Left.Elements (1 .. LN);
+ RE : Elements_Array renames Right.Elements (1 .. RN);
Capacity : constant Count_Type := Length (Left) + Length (Right);
begin
- return (Capacity,
- new Plain_Vector'(Capacity, LE & RE,
- Last => Last, others => <>),
- others => <>);
+ return (Capacity, LE & RE, Last => Last, others => <>);
end;
end;
end "&";
function "&" (Left : Vector; Right : Element_Type) return Vector is
LN : constant Count_Type := Length (Left);
Last_As_Int : Int'Base;
- LFst : Count_Type;
- LLst : Count_Type;
begin
if LN = 0 then
- return (1,
- new Plain_Vector'(1, (1 .. 1 => Right),
- Index_Type'First, others => <>),
- others => <>);
+ return (1, (1 .. 1 => Right), Index_Type'First, others => <>);
end if;
if Int (Index_Type'First) > Int'Last - Int (LN) then
raise Constraint_Error with "new length is out of range";
end if;
- if Left.K = Plain then
- LFst := 1;
- LLst := LN;
- else
- LFst := Left.First;
- LLst := Left.First + LN - 1;
- end if;
-
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
-
- LE : constant Elements_Array (1 .. LN) :=
- Left.Plain.Elements (LFst .. LLst);
+ LE : constant Elements_Array (1 .. LN) := Left.Elements (1 .. LN);
Capacity : constant Count_Type := Length (Left) + 1;
begin
- return (Capacity,
- new Plain_Vector'(Capacity, LE & Right,
- Last => Last, others => <>),
- others => <>);
+ return (Capacity, LE & Right, Last => Last, others => <>);
end;
-
end "&";
function "&" (Left : Element_Type; Right : Vector) return Vector is
RN : constant Count_Type := Length (Right);
Last_As_Int : Int'Base;
- RFst : Count_Type;
- RLst : Count_Type;
-
begin
if RN = 0 then
- return (1,
- new Plain_Vector'(1, (1 .. 1 => Left),
- Index_Type'First, others => <>),
- others => <>);
+ return (1, (1 .. 1 => Left),
+ Index_Type'First, others => <>);
end if;
if Int (Index_Type'First) > Int'Last - Int (RN) then
raise Constraint_Error with "new length is out of range";
end if;
- if Right.K = Plain then
- RFst := 1;
- RLst := RN;
- else
- RFst := Right.First;
- RLst := Right.First + RN - 1;
- end if;
-
declare
- Last : constant Index_Type := Index_Type (Last_As_Int);
-
- RE : Elements_Array renames Right.Plain.Elements (RFst .. RLst);
-
+ Last : constant Index_Type := Index_Type (Last_As_Int);
+ RE : Elements_Array renames Right.Elements (1 .. RN);
Capacity : constant Count_Type := 1 + Length (Right);
-
begin
- return (Capacity,
- new Plain_Vector'(Capacity, Left & RE,
- Last => Last, others => <>),
- others => <>);
+ return (Capacity, Left & RE, Last => Last, others => <>);
end;
end "&";
declare
Last : constant Index_Type := Index_Type'First + 1;
-
begin
- return (2,
- new Plain_Vector'(2, (Left, Right),
- Last => Last, others => <>),
- others => <>);
+ return (2, (Left, Right), Last => Last, others => <>);
end;
end "&";
procedure Append (Container : in out Vector; New_Item : Vector) is
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Is_Empty (New_Item) then
return;
end if;
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with "vector is already at its maximum length";
end if;
- Insert
- (Container,
- Container.Plain.Last + 1,
- New_Item);
+ Insert (Container, Container.Last + 1, New_Item);
end Append;
procedure Append
Count : Count_Type := 1)
is
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Count = 0 then
return;
end if;
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with "vector is already at its maximum length";
end if;
-- TODO: should check whether length > max capacity (cnt_t'last) ???
- Insert
- (Container,
- Container.Plain.Last + 1,
- New_Item,
- Count);
+ Insert (Container, Container.Last + 1, New_Item, Count);
end Append;
------------
procedure Assign (Target : in out Vector; Source : Vector) is
LS : constant Count_Type := Length (Source);
- begin
-
- if Target.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
+ begin
if Target'Address = Source'Address then
return;
end if;
Target.Clear;
- if Source.K = Plain then
- Target.Plain.Elements (1 .. LS) :=
- Source.Plain.Elements (1 .. LS);
- Target.Plain.Last := Source.Plain.Last;
- else
- Target.Plain.Elements (1 .. LS) :=
- Source.Plain.Elements (Source.First .. (Source.First + LS - 1));
- Target.Plain.Last := Source.Last;
- end if;
-
+ Target.Elements (1 .. LS) := Source.Elements (1 .. LS);
+ Target.Last := Source.Last;
end Assign;
--------------
function Capacity (Container : Vector) return Capacity_Subtype is
begin
- return Container.Plain.Elements'Length;
+ return Container.Elements'Length;
end Capacity;
-----------
procedure Clear (Container : in out Vector) is
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
- if Container.Plain.Busy > 0 then
+ if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
- Container.Plain.Last := No_Index;
+ Container.Last := No_Index;
end Clear;
--------------
begin
if Capacity = 0 then
C := LS;
-
elsif Capacity >= LS then
C := Capacity;
-
else
raise Constraint_Error;
end if;
- return Target : Vector (C) do
- if Source.K = Plain then
- Target.Plain.Elements (1 .. LS) :=
- Source.Plain.Elements (1 .. LS);
- Target.Plain.Last := Source.Plain.Last;
- else
- Target.Plain.Elements (1 .. LS) :=
- Source.Plain.Elements (Source.First .. (Source.First + LS - 1));
- Target.Plain.Last := Source.Last;
- end if;
-
+ return Target : Vector (C) do
+ Target.Elements (1 .. LS) := Source.Elements (1 .. LS);
+ Target.Last := Source.Last;
end return;
end Copy;
Count : Count_Type := 1)
is
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Index < Index_Type'First then
raise Constraint_Error with "Index is out of range (too small)";
end if;
- if Index > Container.Plain.Last then
- if Index > Container.Plain.Last + 1 then
+ if Index > Container.Last then
+ if Index > Container.Last + 1 then
raise Constraint_Error with "Index is out of range (too large)";
end if;
return;
end if;
- if Container.Plain.Busy > 0 then
+ if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
declare
I_As_Int : constant Int := Int (Index);
- Old_Last_As_Int : constant Int :=
- Index_Type'Pos (Container.Plain.Last);
+ Old_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);
Count1 : constant Int'Base := Count_Type'Pos (Count);
Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1;
begin
if J_As_Int > Old_Last_As_Int then
- Container.Plain.Last := Index - 1;
+ Container.Last := Index - 1;
else
declare
- EA : Elements_Array renames Container.Plain.Elements;
+ EA : Elements_Array renames Container.Elements;
II : constant Int'Base := I_As_Int - Int (No_Index);
I : constant Count_Type := Count_Type (II);
begin
EA (I .. K) := EA (J .. Length (Container));
- Container.Plain.Last := New_Last;
+ Container.Last := New_Last;
end;
end if;
end;
Count : Count_Type := 1)
is
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if not Position.Valid then
raise Constraint_Error with "Position cursor has no element";
end if;
- if Position.Index > Container.Plain.Last then
+ if Position.Index > Container.Last then
raise Program_Error with "Position index is out of range";
end if;
Count : Count_Type := 1)
is
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Count = 0 then
return;
end if;
Index : Int'Base;
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Count = 0 then
return;
end if;
- if Container.Plain.Busy > 0 then
+ if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
- Index := Int'Base (Container.Plain.Last) - Int'Base (Count);
+ Index := Int'Base (Container.Last) - Int'Base (Count);
if Index < Index_Type'Pos (Index_Type'First) then
- Container.Plain.Last := No_Index;
+ Container.Last := No_Index;
else
- Container.Plain.Last := Index_Type (Index);
+ Container.Last := Index_Type (Index);
end if;
end Delete_Last;
Index : Index_Type) return Element_Type
is
begin
- if Index > Container.Plain.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
declare
II : constant Int'Base := Int (Index) - Int (No_Index);
I : constant Count_Type := Count_Type (II);
-
begin
-
- if Container.K = Part and then
- (I > Length (Container)) then
- raise Constraint_Error with "Index is out of range";
- end if;
-
return Get_Element (Container, I);
end;
end Element;
Position : Cursor) return Element_Type
is
Lst : constant Index_Type := Last_Index (Container);
+
begin
if not Position.Valid then
raise Constraint_Error with "Position cursor has no element";
declare
II : constant Int'Base := Int (Position.Index) - Int (No_Index);
I : constant Count_Type := Count_Type (II);
-
begin
-
return Get_Element (Container, I);
end;
end Element;
Last : constant Index_Type := Last_Index (Container);
begin
-
if Position.Valid then
if Position.Index > Last_Index (Container) then
raise Program_Error with "Position index is out of range";
if Get_Element (Container, K) = Item then
return Cursor'(Index => J, others => <>);
end if;
+
K := K + 1;
end loop;
return No_Element;
-
end Find;
----------------
if Get_Element (Container, K) = Item then
return Indx;
end if;
+
K := K + 1;
end loop;
function Is_Sorted (Container : Vector) return Boolean is
Last : constant Index_Type := Last_Index (Container);
- begin
- if Container.Plain.Last <= Last then
+ begin
+ if Container.Last <= Last then
return True;
end if;
declare
L : constant Capacity_Subtype := Length (Container);
begin
-
for J in Count_Type range 1 .. L - 1 loop
- if Get_Element (Container, J + 1)
- < Get_Element (Container, J) then
+ if Get_Element (Container, J + 1) <
+ Get_Element (Container, J)
+ then
return False;
end if;
end loop;
procedure Merge (Target, Source : in out Vector) is
begin
- if Target.K /= Plain or Source.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
declare
- TA : Elements_Array renames Target.Plain.Elements;
- SA : Elements_Array renames Source.Plain.Elements;
+ TA : Elements_Array renames Target.Elements;
+ SA : Elements_Array renames Source.Elements;
I, J : Count_Type;
return;
end if;
- if Source.Plain.Last < Index_Type'First then
+ if Source.Last < Index_Type'First then
return;
end if;
-- I think we're missing this check in a-convec.adb... ???
- if Target.Plain.Busy > 0 then
+
+ if Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
- if Source.Plain.Busy > 0 then
+ if Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
if I = 0 then
TA (1 .. J) := SA (1 .. Length (Source));
- Source.Plain.Last := No_Index;
+ Source.Last := No_Index;
return;
end if;
- pragma Assert (I <= 1
- or else not (TA (I) < TA (I - 1)));
+ pragma Assert (I <= 1 or else not (TA (I) < TA (I - 1)));
if SA (Length (Source)) < TA (I) then
TA (J) := TA (I);
else
TA (J) := SA (Length (Source));
- Source.Plain.Last := Source.Plain.Last - 1;
+ Source.Last := Source.Last - 1;
end if;
J := J - 1;
"<" => "<");
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
- if Container.Plain.Last <= Index_Type'First then
+ if Container.Last <= Index_Type'First then
return;
end if;
- if Container.Plain.Lock > 0 then
+ if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
- Sort (Container.Plain.Elements (1 .. Length (Container)));
+ Sort (Container.Elements (1 .. Length (Container)));
end Sort;
end Generic_Sorting;
function Get_Element
(Container : Vector;
- Position : Count_Type) return Element_Type is
+ Position : Count_Type) return Element_Type
+ is
begin
- if Container.K = Plain then
- return Container.Plain.Elements (Position);
- end if;
-
- return Container.Plain.Elements (Position + Container.First - 1);
+ return Container.Elements (Position);
end Get_Element;
-----------------
function Has_Element
(Container : Vector;
- Position : Cursor) return Boolean is
+ Position : Cursor) return Boolean
+ is
begin
if not Position.Valid then
return False;
+ else
+ return Position.Index <= Last_Index (Container);
end if;
-
- return Position.Index <= Last_Index (Container);
end Has_Element;
------------
Max_Length : constant UInt := UInt (Container.Capacity);
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Before < Index_Type'First then
raise Constraint_Error with
"Before index is out of range (too small)";
end if;
- if Before > Container.Plain.Last
- and then Before > Container.Plain.Last + 1
+ if Before > Container.Last
+ and then Before > Container.Last + 1
then
raise Constraint_Error with
"Before index is out of range (too large)";
end if;
declare
- Old_Last_As_Int : constant Int := Int (Container.Plain.Last);
+ Old_Last_As_Int : constant Int := Int (Container.Last);
begin
if Old_Last_As_Int > Int'Last - N then
-- Resolve issue of capacity vs. max index ???
end;
- if Container.Plain.Busy > 0 then
+ if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
declare
- EA : Elements_Array renames Container.Plain.Elements;
+ EA : Elements_Array renames Container.Elements;
BB : constant Int'Base := Int (Before) - Int (No_Index);
B : constant Count_Type := Count_Type (BB);
L : constant Count_Type := Count_Type (LL);
begin
- if Before <= Container.Plain.Last then
+ if Before <= Container.Last then
declare
II : constant Int'Base := BB + N;
I : constant Count_Type := Count_Type (II);
-
begin
EA (I .. L) := EA (B .. Length (Container));
EA (B .. I - 1) := (others => New_Item);
end if;
end;
- Container.Plain.Last := New_Last;
+ Container.Last := New_Last;
end Insert;
procedure Insert
N : constant Count_Type := Length (New_Item);
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Before < Index_Type'First then
raise Constraint_Error with
"Before index is out of range (too small)";
end if;
- if Before > Container.Plain.Last
- and then Before > Container.Plain.Last + 1
+ if Before > Container.Last
+ and then Before > Container.Last + 1
then
raise Constraint_Error with
"Before index is out of range (too large)";
Dst_Last : constant Count_Type := Count_Type (Dst_Last_As_Int);
- Src_Fst : Count_Type;
- Src_Lst : Count_Type;
-
BB : constant Int'Base := Int (Before) - Int (No_Index);
B : constant Count_Type := Count_Type (BB);
begin
-
- if Container.K = Plain then
- Src_Fst := 1;
- Src_Lst := N;
- else
- Src_Fst := New_Item.First;
- Src_Lst := N + New_Item.First - 1;
- end if;
-
if Container'Address /= New_Item'Address then
- Container.Plain.Elements (B .. Dst_Last) :=
- New_Item.Plain.Elements (Src_Fst .. Src_Lst);
-
+ Container.Elements (B .. Dst_Last) := New_Item.Elements (1 .. N);
return;
end if;
declare
- Src : Elements_Array renames Container.Plain.Elements (1 .. B - 1);
+ Src : Elements_Array renames Container.Elements (1 .. B - 1);
Index_As_Int : constant Int'Base := BB + Src'Length - 1;
Index : constant Count_Type := Count_Type (Index_As_Int);
- Dst : Elements_Array renames Container.Plain.Elements (B .. Index);
+ Dst : Elements_Array renames Container.Elements (B .. Index);
begin
Dst := Src;
declare
Src : Elements_Array renames
- Container.Plain.Elements
- (Dst_Last + 1 .. Length (Container));
+ Container.Elements (Dst_Last + 1 .. Length (Container));
Index_As_Int : constant Int'Base :=
Dst_Last_As_Int - Src'Length + 1;
Index : constant Count_Type := Count_Type (Index_As_Int);
Dst : Elements_Array renames
- Container.Plain.Elements (Index .. Dst_Last);
+ Container.Elements (Index .. Dst_Last);
begin
Dst := Src;
Index : Index_Type'Base;
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Is_Empty (New_Item) then
return;
end if;
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
end if;
- Index := Container.Plain.Last + 1;
+ Index := Container.Last + 1;
else
Index := Before.Index;
Index : Index_Type'Base;
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Is_Empty (New_Item) then
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
Position := No_Element;
else
end if;
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
end if;
- Index := Container.Plain.Last + 1;
+ Index := Container.Last + 1;
else
Index := Before.Index;
Index : Index_Type'Base;
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Count = 0 then
return;
end if;
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
end if;
- Index := Container.Plain.Last + 1;
+ Index := Container.Last + 1;
else
Index := Before.Index;
Index : Index_Type'Base;
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Count = 0 then
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
Position := No_Element;
else
end if;
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
end if;
- Index := Container.Plain.Last + 1;
+ Index := Container.Last + 1;
else
Index := Before.Index;
is
New_Item : Element_Type; -- Default-initialized value
pragma Warnings (Off, New_Item);
-
begin
Insert (Container, Before, New_Item, Position, Count);
end Insert;
Max_Length : constant UInt := UInt (Count_Type'Last);
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Before < Index_Type'First then
raise Constraint_Error with
"Before index is out of range (too small)";
end if;
- if Before > Container.Plain.Last
- and then Before > Container.Plain.Last + 1
+ if Before > Container.Last
+ and then Before > Container.Last + 1
then
raise Constraint_Error with
"Before index is out of range (too large)";
end if;
declare
- Old_Last_As_Int : constant Int := Int (Container.Plain.Last);
+ Old_Last_As_Int : constant Int := Int (Container.Last);
begin
if Old_Last_As_Int > Int'Last - N then
-- Resolve issue of capacity vs. max index ???
end;
- if Container.Plain.Busy > 0 then
+ if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
declare
- EA : Elements_Array renames Container.Plain.Elements;
+ EA : Elements_Array renames Container.Elements;
BB : constant Int'Base := Int (Before) - Int (No_Index);
B : constant Count_Type := Count_Type (BB);
L : constant Count_Type := Count_Type (LL);
begin
- if Before <= Container.Plain.Last then
+ if Before <= Container.Last then
declare
II : constant Int'Base := BB + N;
I : constant Count_Type := Count_Type (II);
-
begin
EA (I .. L) := EA (B .. Length (Container));
end;
end if;
end;
- Container.Plain.Last := New_Last;
+ Container.Last := New_Last;
end Insert_Space;
procedure Insert_Space
Index : Index_Type'Base;
begin
-
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Count = 0 then
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
Position := No_Element;
else
end if;
if not Before.Valid
- or else Before.Index > Container.Plain.Last
+ or else Before.Index > Container.Last
then
- if Container.Plain.Last = Index_Type'Last then
+ if Container.Last = Index_Type'Last then
raise Constraint_Error with
"vector is already at its maximum length";
end if;
- Index := Container.Plain.Last + 1;
+ Index := Container.Last + 1;
else
Index := Before.Index;
not null access procedure (Container : Vector; Position : Cursor))
is
V : Vector renames Container'Unrestricted_Access.all;
- B : Natural renames V.Plain.Busy;
+ B : Natural renames V.Busy;
begin
B := B + 1;
function Last_Index (Container : Vector) return Extended_Index is
begin
- if Container.K = Plain then
- return Container.Plain.Last;
- else
- return Container.Last;
- end if;
+ return Container.Last;
end Last_Index;
------------
----------
function Left (Container : Vector; Position : Cursor) return Vector is
- Fst : Count_Type;
- begin
- if Container.K = Plain then
- Fst := 1;
- else
- Fst := Container.First;
- end if;
+ C : Vector (Container.Capacity) := Copy (Container, Container.Capacity);
- if not Position.Valid then
- return (Container.Capacity, Container.Plain, Part, Fst,
- Last_Index (Container));
+ begin
+ if Position = No_Element then
+ return C;
end if;
- if Position.Index > Last_Index (Container) then
- raise Constraint_Error with
- "Before index is out of range (too large)";
+ if not Has_Element (Container, Position) then
+ raise Constraint_Error;
end if;
- return (Container.Capacity, Container.Plain, Part, Fst,
- (Position.Index - 1));
+ while C.Last /= Position.Index - 1 loop
+ Delete_Last (C);
+ end loop;
+ return C;
end Left;
----------
begin
- if Target.K /= Plain or Source.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Target'Address = Source'Address then
return;
end if;
- if Target.Plain.Busy > 0 then
+ if Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (Target is busy)";
end if;
- if Source.Plain.Busy > 0 then
+ if Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (Source is busy)";
end if;
-- We could also write this as a loop, and incrementally
-- copy elements from source to target.
- Target.Plain.Last := No_Index; -- in case array assignment files
- Target.Plain.Elements (1 .. N) := Source.Plain.Elements (1 .. N);
+ Target.Last := No_Index; -- in case array assignment files
+ Target.Elements (1 .. N) := Source.Elements (1 .. N);
- Target.Plain.Last := Source.Plain.Last;
- Source.Plain.Last := No_Index;
+ Target.Last := Source.Last;
+ Source.Last := No_Index;
end Move;
----------
Process : not null access procedure (Element : Element_Type))
is
V : Vector renames Container'Unrestricted_Access.all;
- B : Natural renames V.Plain.Busy;
- L : Natural renames V.Plain.Lock;
+ B : Natural renames V.Busy;
+ L : Natural renames V.Lock;
begin
if Index > Last_Index (Container) then
for J in Count_Type range 1 .. Length loop
Last := Last + 1;
- Element_Type'Read (Stream, Container.Plain.Elements (J));
- Container.Plain.Last := Last;
+ Element_Type'Read (Stream, Container.Elements (J));
+ Container.Last := Last;
end loop;
end Read;
New_Item : Element_Type)
is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
- if Index > Container.Plain.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
- if Container.Plain.Lock > 0 then
+ if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
I : constant Count_Type := Count_Type (II);
begin
- Container.Plain.Elements (I) := New_Item;
+ Container.Elements (I) := New_Item;
end;
end Replace_Element;
New_Item : Element_Type)
is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
if not Position.Valid then
raise Constraint_Error with "Position cursor has no element";
end if;
- if Position.Index > Container.Plain.Last then
+ if Position.Index > Container.Last then
raise Constraint_Error with "Position cursor is out of range";
end if;
- if Container.Plain.Lock > 0 then
+ if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
declare
II : constant Int'Base := Int (Position.Index) - Int (No_Index);
I : constant Count_Type := Count_Type (II);
-
begin
- Container.Plain.Elements (I) := New_Item;
+ Container.Elements (I) := New_Item;
end;
end Replace_Element;
Capacity : Capacity_Subtype)
is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Capacity > Container.Capacity then
raise Constraint_Error; -- ???
end if;
procedure Reverse_Elements (Container : in out Vector) is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Length (Container) <= 1 then
return;
end if;
- if Container.Plain.Lock > 0 then
+ if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
declare
I, J : Count_Type;
- E : Elements_Array renames Container.Plain.Elements;
+ E : Elements_Array renames Container.Elements;
begin
I := 1;
while I < J loop
declare
EI : constant Element_Type := E (I);
-
begin
E (I) := E (J);
E (J) := EI;
K : Count_Type;
begin
-
if not Position.Valid
or else Position.Index > Last_Index (Container)
then
if Get_Element (Container, K) = Item then
return (True, Indx);
end if;
+
K := K - 1;
end loop;
if Get_Element (Container, K) = Item then
return Indx;
end if;
+
K := K - 1;
end loop;
procedure Reverse_Iterate
(Container : Vector;
- Process :
- not null access procedure (Container : Vector; Position : Cursor))
+ Process : not null access procedure (Container : Vector;
+ Position : Cursor))
is
V : Vector renames Container'Unrestricted_Access.all;
- B : Natural renames V.Plain.Busy;
+ B : Natural renames V.Busy;
begin
B := B + 1;
-----------
function Right (Container : Vector; Position : Cursor) return Vector is
- Fst : Count_Type;
- begin
- if Container.K = Plain then
- Fst := 1;
- else
- Fst := Container.First;
- end if;
+ C : Vector (Container.Capacity) := Copy (Container, Container.Capacity);
- if not Position.Valid then
- return (Container.Capacity, Container.Plain, Part, Fst, No_Index);
+ begin
+ if Position = No_Element then
+ Clear (C);
+ return C;
end if;
- if Position.Index > Last_Index (Container) then
- raise Constraint_Error with
- "Position index is out of range (too large)";
+ if not Has_Element (Container, Position) then
+ raise Constraint_Error;
end if;
- Fst := Fst + Count_Type (Int (Position.Index) - Int (No_Index)) - 1;
+ while C.Last /= Container.Last - Position.Index + 1 loop
+ Delete_First (C);
+ end loop;
- return (Container.Capacity, Container.Plain, Part, Fst,
- (Last_Index (Container) - Position.Index + 1));
+ return C;
end Right;
----------------
Length : Capacity_Subtype)
is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if Length = Formal_Vectors.Length (Container) then
return;
end if;
- if Container.Plain.Busy > 0 then
+ if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is busy)";
end if;
Last_As_Int : constant Int'Base :=
Int (Index_Type'First) + Int (Length) - 1;
begin
- Container.Plain.Last := Index_Type'Base (Last_As_Int);
+ Container.Last := Index_Type'Base (Last_As_Int);
end;
end Set_Length;
procedure Swap (Container : in out Vector; I, J : Index_Type) is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
- if I > Container.Plain.Last then
+ if I > Container.Last then
raise Constraint_Error with "I index is out of range";
end if;
- if J > Container.Plain.Last then
+ if J > Container.Last then
raise Constraint_Error with "J index is out of range";
end if;
return;
end if;
- if Container.Plain.Lock > 0 then
+ if Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (vector is locked)";
end if;
II : constant Int'Base := Int (I) - Int (No_Index);
JJ : constant Int'Base := Int (J) - Int (No_Index);
- EI : Element_Type renames Container.Plain.Elements (Count_Type (II));
- EJ : Element_Type renames Container.Plain.Elements (Count_Type (JJ));
+ EI : Element_Type renames Container.Elements (Count_Type (II));
+ EJ : Element_Type renames Container.Elements (Count_Type (JJ));
EI_Copy : constant Element_Type := EI;
procedure Swap (Container : in out Vector; I, J : Cursor) is
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
-
if not I.Valid then
raise Constraint_Error with "I cursor has no element";
end if;
Last := Index_Type (Last_As_Int);
- return (Length,
- new Plain_Vector'(Length, (others => <>), Last => Last,
- others => <>),
+ return (Length, (others => <>), Last => Last,
others => <>);
end;
end To_Vector;
Last := Index_Type (Last_As_Int);
- return (Length,
- new Plain_Vector'(Length, (others => New_Item), Last => Last,
- others => <>),
+ return (Length, (others => New_Item), Last => Last,
others => <>);
end;
end To_Vector;
Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type))
is
- B : Natural renames Container.Plain.Busy;
- L : Natural renames Container.Plain.Lock;
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
begin
- if Container.K /= Plain then
- raise Constraint_Error
- with "Can't modify part of container";
- end if;
- if Index > Container.Plain.Last then
+ if Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
I : constant Count_Type := Count_Type (II);
begin
- Process (Container.Plain.Elements (I));
+ Process (Container.Elements (I));
exception
when others =>
L := L - 1;
Count_Type'Base'Write (Stream, Length (Container));
for J in 1 .. Length (Container) loop
- Element_Type'Write (Stream, Container.Plain.Elements (J));
+ Element_Type'Write (Stream, Container.Elements (J));
end loop;
end Write;
OSDN Git Service
