diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-03 10:38:26 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-03 10:38:26 +0000 |
| commit | 098d3082ab1e8ba60b762e7663cdb3a70a9c963e (patch) | |
| tree | fc7be1c9704d0d4e2e74847db194b13f6d7fc48a /gcc/ada/a-cforma.adb | |
| parent | 039fcfa6316d4a70d271d974f9ded9c2001a97b8 (diff) | |
| download | gcc-098d3082ab1e8ba60b762e7663cdb3a70a9c963e.tar.gz | |
2011-08-03 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, prj-proc.adb, mlib-prj.adb, prj.adb, makeutl.ads,
prj-util.adb, prj-util.ads, prj-conf.adb, prj-env.adb: Minor
reformatting.
2011-08-03 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Is_VM_By_Copy_Actual): Include N_Slide nodes as actuals
that must be passed by copy in VM targets.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj.ads, prj-nmsc.adb (Files_Htable): removed this htable, which
duplicates a similar htable now in the project tree.
2011-08-03 Claire Dross <dross@adacore.com>
* a-cfdlli.adb, a-cfhama.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb,
a-cofove.adb ("=", Length, Is_Empty, Clear, Assign, Copy, Element,
Replace_Element, Query_Element, Update_Element, Move, Insert, Prepend,
Append, Delete, Delete_First, Delete_Last, Reverse_Element, Swap,
Splice, First, First_Element, Last, Last_Element, Next, Previous, Find,
Reverse_Find, Contains, Has_Element, Iterate, Reverse_Iterate, Capacity,
Reserve_Length, Length, Strict_Equal, Left, Right): Data-structure
update.
2011-08-03 Arnaud Charlet <charlet@adacore.com>
* s-taprop-posix.adb, s-taprop-linux.adb, s-taprop-tru64.adb
(ATCB_Key): Removed, not always used.
* s-tpopsp-posix.adb, s-tpopsp-posix-foreign.adb (ATCB_Key): Moved from
s-taprop-posix.adb.
* s-tpopsp-tls.adb: New file.
* gcc-interface/Makefile.in: Use TLS implementation of s-tpopsp.adb on
x86/x64/ia64/powerpc/sparc Linux.
2011-08-03 Arnaud Charlet <charlet@adacore.com>
* system-aix.ads, system-aix64.ads: Set ZCX_By_Default to True.
* gcc-interface/Makefile.in: Switch to ZCX by default on AIX ports.
2011-08-03 Thomas Quinot <quinot@adacore.com>
* rtsfind.ads, exp_dist.adb, exp_dist.ads
(Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call):
Fix type selection for mapping integer types to PolyORB types.
2011-08-03 Bob Duff <duff@adacore.com>
* sem_ch7.adb: Minor comment clarification.
2011-08-03 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): If we get
an error analyzing a choice, skip further processing. Further
processing could cause a crash or cascade errors.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177262 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/a-cforma.adb')
| -rw-r--r-- | gcc/ada/a-cforma.adb | 735 |
1 files changed, 209 insertions, 526 deletions
diff --git a/gcc/ada/a-cforma.adb b/gcc/ada/a-cforma.adb index 705fd618e9f..ecd8de5f87c 100644 --- a/gcc/ada/a-cforma.adb +++ b/gcc/ada/a-cforma.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010, Free Software Foundation, Inc. -- +-- 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- -- @@ -80,7 +80,7 @@ package body Ada.Containers.Formal_Ordered_Maps is (Tree : in out Tree_Types.Tree_Type'Class; Node : out Count_Type); - procedure Free (Tree : in out Tree_Types.Tree_Type; X : Count_Type); + procedure Free (Tree : in out Map; X : Count_Type); function Is_Greater_Key_Node (Left : Key_Type; @@ -92,10 +92,6 @@ package body Ada.Containers.Formal_Ordered_Maps is Right : Node_Type) return Boolean; pragma Inline (Is_Less_Key_Node); - function Next_Unchecked - (Container : Map; - Position : Count_Type) return Count_Type; - -------------------------- -- Local Instantiations -- -------------------------- @@ -133,15 +129,15 @@ package body Ada.Containers.Formal_Ordered_Maps is return True; end if; - Lst := Next (Left.Tree.all, Last (Left).Node); + Lst := Next (Left, Last (Left).Node); while Node /= Lst loop - ENode := Find (Right, Left.Tree.Nodes (Node).Key).Node; + ENode := Find (Right, Left.Nodes (Node).Key).Node; if ENode = 0 or else - Left.Tree.Nodes (Node).Element /= Right.Tree.Nodes (ENode).Element + Left.Nodes (Node).Element /= Right.Nodes (ENode).Element then return False; end if; - Node := Next (Left.Tree.all, Node); + Node := Next (Left, Node); end loop; return True; @@ -163,7 +159,7 @@ package body Ada.Containers.Formal_Ordered_Maps is -------------------- procedure Append_Element (Source_Node : Count_Type) is - SN : Node_Type renames Source.Tree.Nodes (Source_Node); + SN : Node_Type renames Source.Nodes (Source_Node); procedure Set_Element (Node : in out Node_Type); pragma Inline (Set_Element); @@ -193,7 +189,7 @@ package body Ada.Containers.Formal_Ordered_Maps is Result : Count_Type; begin - Allocate (Target.Tree.all, Result); + Allocate (Target, Result); return Result; end New_Node; @@ -213,7 +209,7 @@ package body Ada.Containers.Formal_Ordered_Maps is begin Unconditional_Insert_Avec_Hint - (Tree => Target.Tree.all, + (Tree => Target, Hint => 0, Key => SN.Key, Node => Target_Node); @@ -222,10 +218,6 @@ package body Ada.Containers.Formal_Ordered_Maps is -- Start of processing for Assign begin - if Target.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if Target'Address = Source'Address then return; @@ -235,21 +227,8 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Storage_Error with "not enough capacity"; -- SE or CE? ??? end if; - Tree_Operations.Clear_Tree (Target.Tree.all); - - if Source.K = Plain then - Append_Elements (Source.Tree.all); - else - declare - X : Count_Type; - begin - X := Source.First; - while X /= Next (Source.Tree.all, Source.Last) loop - Append_Element (X); - X := Next (Source.Tree.all, X); - end loop; - end; - end if; + Tree_Operations.Clear_Tree (Target); + Append_Elements (Source); end Assign; ------------- @@ -257,33 +236,16 @@ package body Ada.Containers.Formal_Ordered_Maps is ------------- function Ceiling (Container : Map; Key : Key_Type) return Cursor is - begin - if Container.K = Part then - if Container.Length = 0 then - return No_Element; - end if; + Node : constant Count_Type := + Key_Ops.Ceiling (Container, Key); - if Key < Container.Tree.Nodes (Container.First).Key then - return (Node => Container.First); - end if; - - if Container.Tree.Nodes (Container.Last).Key < Key then - return No_Element; - end if; + begin + if Node = 0 then + return No_Element; end if; - declare - Node : constant Count_Type := - Key_Ops.Ceiling (Container.Tree.all, Key); - - begin - if Node = 0 then - return No_Element; - end if; - - return (Node => Node); - end; + return (Node => Node); end Ceiling; ----------- @@ -292,12 +254,8 @@ package body Ada.Containers.Formal_Ordered_Maps is procedure Clear (Container : in out Map) is begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; - Tree_Operations.Clear_Tree (Container.Tree.all); + Tree_Operations.Clear_Tree (Container); end Clear; ----------- @@ -325,56 +283,38 @@ package body Ada.Containers.Formal_Ordered_Maps is function Copy (Source : Map; Capacity : Count_Type := 0) return Map is Node : Count_Type := 1; N : Count_Type; - Cu : Cursor; begin return Target : Map (Count_Type'Max (Source.Capacity, Capacity)) do if Length (Source) > 0 then - Target.Tree.Length := Source.Tree.Length; - Target.Tree.Root := Source.Tree.Root; - Target.Tree.First := Source.Tree.First; - Target.Tree.Last := Source.Tree.Last; - Target.Tree.Free := Source.Tree.Free; + Target.Length := Source.Length; + Target.Root := Source.Root; + Target.First := Source.First; + Target.Last := Source.Last; + Target.Free := Source.Free; while Node <= Source.Capacity loop - Target.Tree.Nodes (Node).Element := - Source.Tree.Nodes (Node).Element; - Target.Tree.Nodes (Node).Key := - Source.Tree.Nodes (Node).Key; - Target.Tree.Nodes (Node).Parent := - Source.Tree.Nodes (Node).Parent; - Target.Tree.Nodes (Node).Left := - Source.Tree.Nodes (Node).Left; - Target.Tree.Nodes (Node).Right := - Source.Tree.Nodes (Node).Right; - Target.Tree.Nodes (Node).Color := - Source.Tree.Nodes (Node).Color; - Target.Tree.Nodes (Node).Has_Element := - Source.Tree.Nodes (Node).Has_Element; + Target.Nodes (Node).Element := + Source.Nodes (Node).Element; + Target.Nodes (Node).Key := + Source.Nodes (Node).Key; + Target.Nodes (Node).Parent := + Source.Nodes (Node).Parent; + Target.Nodes (Node).Left := + Source.Nodes (Node).Left; + Target.Nodes (Node).Right := + Source.Nodes (Node).Right; + Target.Nodes (Node).Color := + Source.Nodes (Node).Color; + Target.Nodes (Node).Has_Element := + Source.Nodes (Node).Has_Element; Node := Node + 1; end loop; while Node <= Target.Capacity loop N := Node; - Formal_Ordered_Maps.Free (Tree => Target.Tree.all, X => N); + Formal_Ordered_Maps.Free (Tree => Target, X => N); Node := Node + 1; end loop; - - if Source.K = Part then - Node := Target.Tree.First; - while Node /= Source.First loop - Cu := (Node => Node); - Node := Next (Target.Tree.all, Node); - Delete (Target, Cu); - end loop; - - Node := Next (Target.Tree.all, Source.Last); - - while Node /= 0 loop - Cu := (Node => Node); - Node := Next (Target.Tree.all, Node); - Delete (Target, Cu); - end loop; - end if; end if; end return; end Copy; @@ -385,41 +325,31 @@ package body Ada.Containers.Formal_Ordered_Maps is procedure Delete (Container : in out Map; Position : in out Cursor) is begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if not Has_Element (Container, Position) then raise Constraint_Error with "Position cursor of Delete has no element"; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "Position cursor of Delete is bad"); - Tree_Operations.Delete_Node_Sans_Free (Container.Tree.all, + Tree_Operations.Delete_Node_Sans_Free (Container, Position.Node); - Formal_Ordered_Maps.Free (Container.Tree.all, Position.Node); + Formal_Ordered_Maps.Free (Container, Position.Node); end Delete; procedure Delete (Container : in out Map; Key : Key_Type) is + + X : constant Node_Access := Key_Ops.Find (Container, Key); + begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; + if X = 0 then + raise Constraint_Error with "key not in map"; end if; - declare - X : constant Node_Access := Key_Ops.Find (Container.Tree.all, Key); - - begin - if X = 0 then - raise Constraint_Error with "key not in map"; - end if; - Tree_Operations.Delete_Node_Sans_Free (Container.Tree.all, X); - Formal_Ordered_Maps.Free (Container.Tree.all, X); - end; + Tree_Operations.Delete_Node_Sans_Free (Container, X); + Formal_Ordered_Maps.Free (Container, X); end Delete; ------------------ @@ -430,14 +360,10 @@ package body Ada.Containers.Formal_Ordered_Maps is X : constant Node_Access := First (Container).Node; begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if X /= 0 then - Tree_Operations.Delete_Node_Sans_Free (Container.Tree.all, X); - Formal_Ordered_Maps.Free (Container.Tree.all, X); + Tree_Operations.Delete_Node_Sans_Free (Container, X); + Formal_Ordered_Maps.Free (Container, X); end if; end Delete_First; @@ -449,14 +375,10 @@ package body Ada.Containers.Formal_Ordered_Maps is X : constant Node_Access := Last (Container).Node; begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if X /= 0 then - Tree_Operations.Delete_Node_Sans_Free (Container.Tree.all, X); - Formal_Ordered_Maps.Free (Container.Tree.all, X); + Tree_Operations.Delete_Node_Sans_Free (Container, X); + Formal_Ordered_Maps.Free (Container, X); end if; end Delete_Last; @@ -471,10 +393,10 @@ package body Ada.Containers.Formal_Ordered_Maps is "Position cursor of function Element has no element"; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "Position cursor of function Element is bad"); - return Container.Tree.Nodes (Position.Node).Element; + return Container.Nodes (Position.Node).Element; end Element; @@ -486,7 +408,7 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error with "key not in map"; end if; - return Container.Tree.Nodes (Node).Element; + return Container.Nodes (Node).Element; end Element; --------------------- @@ -509,17 +431,13 @@ package body Ada.Containers.Formal_Ordered_Maps is ------------- procedure Exclude (Container : in out Map; Key : Key_Type) is - X : constant Node_Access := Key_Ops.Find (Container.Tree.all, Key); + X : constant Node_Access := Key_Ops.Find (Container, Key); begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if X /= 0 then - Tree_Operations.Delete_Node_Sans_Free (Container.Tree.all, X); - Formal_Ordered_Maps.Free (Container.Tree.all, X); + Tree_Operations.Delete_Node_Sans_Free (Container, X); + Formal_Ordered_Maps.Free (Container, X); end if; end Exclude; @@ -528,29 +446,16 @@ package body Ada.Containers.Formal_Ordered_Maps is ---------- function Find (Container : Map; Key : Key_Type) return Cursor is - begin - if Container.K = Part then - if Container.Length = 0 then - return No_Element; - end if; - if Key < Container.Tree.Nodes (Container.First).Key or - Container.Tree.Nodes (Container.Last).Key < Key then - return No_Element; - end if; - end if; - - declare - Node : constant Count_Type := - Key_Ops.Find (Container.Tree.all, Key); + Node : constant Count_Type := + Key_Ops.Find (Container, Key); - begin - if Node = 0 then - return No_Element; - end if; + begin + if Node = 0 then + return No_Element; + end if; - return (Node => Node); - end; + return (Node => Node); end Find; ----------- @@ -563,11 +468,7 @@ package body Ada.Containers.Formal_Ordered_Maps is return No_Element; end if; - if Container.K = Plain then - return (Node => Container.Tree.First); - else - return (Node => Container.First); - end if; + return (Node => Container.First); end First; @@ -581,7 +482,7 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error with "map is empty"; end if; - return Container.Tree.Nodes (First (Container).Node).Element; + return Container.Nodes (First (Container).Node).Element; end First_Element; --------------- @@ -594,7 +495,7 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error with "map is empty"; end if; - return Container.Tree.Nodes (First (Container).Node).Key; + return Container.Nodes (First (Container).Node).Key; end First_Key; ----------- @@ -602,33 +503,16 @@ package body Ada.Containers.Formal_Ordered_Maps is ----------- function Floor (Container : Map; Key : Key_Type) return Cursor is - begin - - if Container.K = Part then - if Container.Length = 0 then - return No_Element; - end if; - if Key < Container.Tree.Nodes (Container.First).Key then - return No_Element; - end if; + Node : constant Count_Type := + Key_Ops.Floor (Container, Key); - if Container.Tree.Nodes (Container.Last).Key < Key then - return (Node => Container.Last); - end if; + begin + if Node = 0 then + return No_Element; end if; - declare - Node : constant Count_Type := - Key_Ops.Floor (Container.Tree.all, Key); - - begin - if Node = 0 then - return No_Element; - end if; - - return (Node => Node); - end; + return (Node => Node); end Floor; ---------- @@ -636,7 +520,7 @@ package body Ada.Containers.Formal_Ordered_Maps is ---------- procedure Free - (Tree : in out Tree_Types.Tree_Type; + (Tree : in out Map; X : Count_Type) is begin @@ -671,25 +555,7 @@ package body Ada.Containers.Formal_Ordered_Maps is return False; end if; - if not Container.Tree.Nodes (Position.Node).Has_Element then - return False; - end if; - - if Container.K = Plain then - return True; - end if; - - declare - Key : constant Key_Type := Container.Tree.Nodes (Position.Node).Key; - begin - - if Key < Container.Tree.Nodes (Container.First).Key or - Container.Tree.Nodes (Container.Last).Key < Key then - return False; - end if; - - return True; - end; + return Container.Nodes (Position.Node).Has_Element; end Has_Element; ------------- @@ -708,13 +574,13 @@ package body Ada.Containers.Formal_Ordered_Maps is Insert (Container, Key, New_Item, Position, Inserted); if not Inserted then - if Container.Tree.Lock > 0 then + if Container.Lock > 0 then raise Program_Error with "attempt to tamper with cursors (map is locked)"; end if; declare - N : Node_Type renames Container.Tree.Nodes (Position.Node); + N : Node_Type renames Container.Nodes (Position.Node); begin N.Key := Key; N.Element := New_Item; @@ -729,51 +595,43 @@ package body Ada.Containers.Formal_Ordered_Maps is Position : out Cursor; Inserted : out Boolean) is - begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; + function New_Node return Node_Access; - declare - function New_Node return Node_Access; - - procedure Insert_Post is - new Key_Ops.Generic_Insert_Post (New_Node); - - procedure Insert_Sans_Hint is - new Key_Ops.Generic_Conditional_Insert (Insert_Post); - - -------------- - -- New_Node -- - -------------- + procedure Insert_Post is + new Key_Ops.Generic_Insert_Post (New_Node); - function New_Node return Node_Access is - procedure Initialize (Node : in out Node_Type); - procedure Allocate_Node is new Generic_Allocate (Initialize); + procedure Insert_Sans_Hint is + new Key_Ops.Generic_Conditional_Insert (Insert_Post); - procedure Initialize (Node : in out Node_Type) is - begin - Node.Key := Key; - Node.Element := New_Item; - end Initialize; + -------------- + -- New_Node -- + -------------- - X : Node_Access; + function New_Node return Node_Access is + procedure Initialize (Node : in out Node_Type); + procedure Allocate_Node is new Generic_Allocate (Initialize); + procedure Initialize (Node : in out Node_Type) is begin - Allocate_Node (Container.Tree.all, X); - return X; - end New_Node; + Node.Key := Key; + Node.Element := New_Item; + end Initialize; - -- Start of processing for Insert + X : Node_Access; begin - Insert_Sans_Hint - (Container.Tree.all, - Key, - Position.Node, - Inserted); - end; + Allocate_Node (Container, X); + return X; + end New_Node; + + -- Start of processing for Insert + + begin + Insert_Sans_Hint + (Container, + Key, + Position.Node, + Inserted); end Insert; procedure Insert @@ -802,50 +660,42 @@ package body Ada.Containers.Formal_Ordered_Maps is Position : out Cursor; Inserted : out Boolean) is - begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; - - declare - function New_Node return Node_Access; - - procedure Insert_Post is - new Key_Ops.Generic_Insert_Post (New_Node); - - procedure Insert_Sans_Hint is - new Key_Ops.Generic_Conditional_Insert (Insert_Post); + function New_Node return Node_Access; - -------------- - -- New_Node -- - -------------- + procedure Insert_Post is + new Key_Ops.Generic_Insert_Post (New_Node); - function New_Node return Node_Access is - procedure Initialize (Node : in out Node_Type); - procedure Allocate_Node is new Generic_Allocate (Initialize); + procedure Insert_Sans_Hint is + new Key_Ops.Generic_Conditional_Insert (Insert_Post); - procedure Initialize (Node : in out Node_Type) is - begin - Node.Key := Key; - end Initialize; + -------------- + -- New_Node -- + -------------- - X : Node_Access; + function New_Node return Node_Access is + procedure Initialize (Node : in out Node_Type); + procedure Allocate_Node is new Generic_Allocate (Initialize); + procedure Initialize (Node : in out Node_Type) is begin - Allocate_Node (Container.Tree.all, X); - return X; - end New_Node; + Node.Key := Key; + end Initialize; - -- Start of processing for Insert + X : Node_Access; begin - Insert_Sans_Hint - (Container.Tree.all, - Key, - Position.Node, - Inserted); - end; + Allocate_Node (Container, X); + return X; + end New_Node; + + -- Start of processing for Insert + + begin + Insert_Sans_Hint + (Container, + Key, + Position.Node, + Inserted); end Insert; -------------- @@ -907,7 +757,7 @@ package body Ada.Containers.Formal_Ordered_Maps is Process (Container, (Node => Node)); end Process_Node; - B : Natural renames Container.Tree.all.Busy; + B : Natural renames Container'Unrestricted_Access.Busy; -- Start of processing for Iterate @@ -915,44 +765,7 @@ package body Ada.Containers.Formal_Ordered_Maps is B := B + 1; begin - - if Container.K = Plain then - Local_Iterate (Container.Tree.all); - return; - end if; - - if Container.Length = 0 then - return; - end if; - - declare - FElt : constant Key_Type := - Container.Tree.Nodes (Container.First).Key; - TElt : constant Key_Type := - Container.Tree.Nodes (Container.Last).Key; - - procedure Iterate (P : Count_Type); - - procedure Iterate (P : Count_Type) is - X : Count_Type := P; - begin - while X /= 0 loop - if Container.Tree.Nodes (X).Key < FElt then - X := Container.Tree.Nodes (X).Right; - elsif TElt < Container.Tree.Nodes (X).Key then - X := Container.Tree.Nodes (X).Left; - else - Iterate (Container.Tree.Nodes (X).Left); - Process_Node (X); - X := Container.Tree.Nodes (X).Right; - end if; - end loop; - end Iterate; - - begin - Iterate (Container.Tree.Root); - end; - + Local_Iterate (Container); exception when others => B := B - 1; @@ -973,10 +786,10 @@ package body Ada.Containers.Formal_Ordered_Maps is "Position cursor of function Key has no element"; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "Position cursor of function Key is bad"); - return Container.Tree.Nodes (Position.Node).Key; + return Container.Nodes (Position.Node).Key; end Key; ---------- @@ -988,11 +801,6 @@ package body Ada.Containers.Formal_Ordered_Maps is if Length (Container) = 0 then return No_Element; end if; - - if Container.K = Plain then - return (Node => Container.Tree.Last); - end if; - return (Node => Container.Last); end Last; @@ -1006,7 +814,7 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error with "map is empty"; end if; - return Container.Tree.Nodes (Last (Container).Node).Element; + return Container.Nodes (Last (Container).Node).Element; end Last_Element; -------------- @@ -1019,7 +827,7 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error with "map is empty"; end if; - return Container.Tree.Nodes (Last (Container).Node).Key; + return Container.Nodes (Last (Container).Node).Key; end Last_Key; ---------- @@ -1027,35 +835,24 @@ package body Ada.Containers.Formal_Ordered_Maps is ---------- function Left (Container : Map; Position : Cursor) return Map is - Lst : Count_Type; - Fst : constant Count_Type := First (Container).Node; - L : Count_Type := 0; - C : Count_Type := Fst; + Curs : Cursor := Position; + C : Map (Container.Capacity) := + Copy (Container, Container.Capacity); + Node : Count_Type; begin - while C /= Position.Node loop - if C = Last (Container).Node or C = 0 then - raise Constraint_Error with - "Position cursor has no element"; - end if; - Lst := C; - C := Next (Container.Tree.all, C); - L := L + 1; - end loop; - if L = 0 then - return (Capacity => Container.Capacity, - K => Part, - Tree => Container.Tree, - Length => 0, - First => 0, - Last => 0); - else - return (Capacity => Container.Capacity, - K => Part, - Tree => Container.Tree, - Length => L, - First => Fst, - Last => Lst); + if Curs = No_Element then + return C; end if; + if not Has_Element (Container, Curs) then + raise Constraint_Error; + end if; + + while Curs.Node /= 0 loop + Node := Curs.Node; + Delete (C, Curs); + Curs := Next (Container, (Node => Node)); + end loop; + return C; end Left; -------------- @@ -1073,11 +870,7 @@ package body Ada.Containers.Formal_Ordered_Maps is function Length (Container : Map) return Count_Type is begin - if Container.K = Plain then - return Container.Tree.Length; - else - return Container.Length; - end if; + return Container.Length; end Length; ---------- @@ -1085,14 +878,10 @@ package body Ada.Containers.Formal_Ordered_Maps is ---------- procedure Move (Target : in out Map; Source : in out Map) is - NN : Tree_Types.Nodes_Type renames Source.Tree.Nodes; + NN : Tree_Types.Nodes_Type renames Source.Nodes; X : Node_Access; 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; @@ -1103,7 +892,7 @@ package body Ada.Containers.Formal_Ordered_Maps is "Source length exceeds Target capacity"; end if; - if Source.Tree.Busy > 0 then + if Source.Busy > 0 then raise Program_Error with "attempt to tamper with cursors of Source (list is busy)"; end if; @@ -1121,8 +910,8 @@ package body Ada.Containers.Formal_Ordered_Maps is Insert (Target, NN (X).Key, NN (X).Element); -- optimize??? - Tree_Operations.Delete_Node_Sans_Free (Source.Tree.all, X); - Formal_Ordered_Maps.Free (Source.Tree.all, X); + Tree_Operations.Delete_Node_Sans_Free (Source, X); + Formal_Ordered_Maps.Free (Source, X); end loop; end Move; @@ -1130,19 +919,6 @@ package body Ada.Containers.Formal_Ordered_Maps is -- Next -- ---------- - function Next_Unchecked - (Container : Map; - Position : Count_Type) return Count_Type is - begin - - if Container.K = Part and then - (Container.Length = 0 or Position = Container.Last) then - return 0; - end if; - - return Tree_Operations.Next (Container.Tree.all, Position); - end Next_Unchecked; - procedure Next (Container : Map; Position : in out Cursor) is begin Position := Next (Container, Position); @@ -1158,10 +934,10 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "bad cursor in Next"); - return (Node => Next_Unchecked (Container, Position.Node)); + return (Node => Tree_Operations.Next (Container, Position.Node)); end Next; ------------- @@ -1181,9 +957,9 @@ package body Ada.Containers.Formal_Ordered_Maps is R_Node : Count_Type := First (Right).Node; L_Last : constant Count_Type := - Next (Left.Tree.all, Last (Left).Node); + Next (Left, Last (Left).Node); R_Last : constant Count_Type := - Next (Right.Tree.all, Last (Right).Node); + Next (Right, Last (Right).Node); begin if Left'Address = Right'Address then @@ -1197,12 +973,12 @@ package body Ada.Containers.Formal_Ordered_Maps is return False; end if; - if Left.Tree.Nodes (L_Node).Key - < Right.Tree.Nodes (R_Node).Key then - L_Node := Next (Left.Tree.all, L_Node); - elsif Right.Tree.Nodes (R_Node).Key - < Left.Tree.Nodes (L_Node).Key then - R_Node := Next (Right.Tree.all, R_Node); + if Left.Nodes (L_Node).Key + < Right.Nodes (R_Node).Key then + L_Node := Next (Left, L_Node); + elsif Right.Nodes (R_Node).Key + < Left.Nodes (L_Node).Key then + R_Node := Next (Right, R_Node); else return True; @@ -1239,18 +1015,12 @@ package body Ada.Containers.Formal_Ordered_Maps is raise Constraint_Error; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "bad cursor in Previous"); - if Container.K = Part and then - (Container.Length = 0 or Position.Node = Container.First) then - return No_Element; - end if; - declare - Tree : Tree_Types.Tree_Type renames Container.Tree.all; Node : constant Count_Type := - Tree_Operations.Previous (Tree, Position.Node); + Tree_Operations.Previous (Container, Position.Node); begin if Node = 0 then @@ -1272,31 +1042,26 @@ package body Ada.Containers.Formal_Ordered_Maps is Element : Element_Type)) is begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if not Has_Element (Container, Position) then raise Constraint_Error with "Position cursor of Query_Element has no element"; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "Position cursor of Query_Element is bad"); declare - T : Tree_Types.Tree_Type renames Container.Tree.all; - B : Natural renames T.Busy; - L : Natural renames T.Lock; + B : Natural renames Container.Busy; + L : Natural renames Container.Lock; begin B := B + 1; L := L + 1; declare - N : Node_Type renames T.Nodes (Position.Node); + N : Node_Type renames Container.Nodes (Position.Node); K : Key_Type renames N.Key; E : Element_Type renames N.Element; @@ -1342,20 +1107,9 @@ package body Ada.Containers.Formal_Ordered_Maps is end Read_Element; -- Start of processing for Read - Result : Tree_Type_Access; begin - if Container.K /= Plain then - raise Constraint_Error; - end if; - - if Container.Tree = null then - Result := new Tree_Types.Tree_Type (Container.Capacity); - else - Result := Container.Tree; - end if; - Read_Elements (Stream, Result.all); - Container.Tree := Result; + Read_Elements (Stream, Container); end Read; procedure Read @@ -1377,26 +1131,21 @@ package body Ada.Containers.Formal_Ordered_Maps is is begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; - declare - Node : constant Node_Access := Key_Ops.Find (Container.Tree.all, Key); + Node : constant Node_Access := Key_Ops.Find (Container, Key); begin if Node = 0 then raise Constraint_Error with "key not in map"; end if; - if Container.Tree.Lock > 0 then + if Container.Lock > 0 then raise Program_Error with "attempt to tamper with cursors (map is locked)"; end if; declare - N : Node_Type renames Container.Tree.Nodes (Node); + N : Node_Type renames Container.Nodes (Node); begin N.Key := Key; N.Element := New_Item; @@ -1414,25 +1163,21 @@ package body Ada.Containers.Formal_Ordered_Maps is 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 Has_Element (Container, Position) then raise Constraint_Error with "Position cursor of Replace_Element has no element"; end if; - if Container.Tree.Lock > 0 then + if Container.Lock > 0 then raise Program_Error with "attempt to tamper with cursors (map is locked)"; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "Position cursor of Replace_Element is bad"); - Container.Tree.Nodes (Position.Node).Element := New_Item; + Container.Nodes (Position.Node).Element := New_Item; end Replace_Element; --------------------- @@ -1459,7 +1204,7 @@ package body Ada.Containers.Formal_Ordered_Maps is Process (Container, (Node => Node)); end Process_Node; - B : Natural renames Container.Tree.Busy; + B : Natural renames Container'Unrestricted_Access.Busy; -- Start of processing for Reverse_Iterate @@ -1467,43 +1212,7 @@ package body Ada.Containers.Formal_Ordered_Maps is B := B + 1; begin - - if Container.K = Plain then - Local_Reverse_Iterate (Container.Tree.all); - return; - end if; - - if Container.Length = 0 then - return; - end if; - - declare - FElt : constant Key_Type := - Container.Tree.Nodes (Container.First).Key; - TElt : constant Key_Type := - Container.Tree.Nodes (Container.Last).Key; - - procedure Iterate (P : Count_Type); - - procedure Iterate (P : Count_Type) is - X : Count_Type := P; - begin - while X /= 0 loop - if Container.Tree.Nodes (X).Key < FElt then - X := Container.Tree.Nodes (X).Right; - elsif TElt < Container.Tree.Nodes (X).Key then - X := Container.Tree.Nodes (X).Left; - else - Iterate (Container.Tree.Nodes (X).Right); - Process_Node (X); - X := Container.Tree.Nodes (X).Left; - end if; - end loop; - end Iterate; - - begin - Iterate (Container.Tree.Root); - end; + Local_Reverse_Iterate (Container); exception when others => @@ -1519,46 +1228,25 @@ package body Ada.Containers.Formal_Ordered_Maps is ----------- function Right (Container : Map; Position : Cursor) return Map is - Lst : Count_Type; - L : Count_Type := 0; - C : Count_Type := Position.Node; + Curs : Cursor := First (Container); + C : Map (Container.Capacity) := + Copy (Container, Container.Capacity); + Node : Count_Type; begin - - if C = 0 then - return (Capacity => Container.Capacity, - K => Part, - Tree => Container.Tree, - Length => 0, - First => 0, - Last => 0); - end if; - - if Container.K = Plain then - Lst := 0; - else - Lst := Next (Container.Tree.all, Container.Last); + if Curs = No_Element then + Clear (C); + return C; end if; - - if C = Lst then - raise Constraint_Error with - "Position cursor has no element"; + if Position /= No_Element and not Has_Element (Container, Position) then + raise Constraint_Error; end if; - while C /= Lst loop - if C = 0 then - raise Constraint_Error with - "Position cursor has no element"; - end if; - C := Next (Container.Tree.all, C); - L := L + 1; + while Curs.Node /= Position.Node loop + Node := Curs.Node; + Delete (C, Curs); + Curs := Next (Container, (Node => Node)); end loop; - - return (Capacity => Container.Capacity, - K => Part, - Tree => Container.Tree, - Length => L, - First => Position.Node, - Last => Last (Container).Node); + return C; end Right; --------------- @@ -1626,14 +1314,14 @@ package body Ada.Containers.Formal_Ordered_Maps is return True; end if; - if Left.Tree.Nodes (LNode).Element /= - Right.Tree.Nodes (RNode).Element or - Left.Tree.Nodes (LNode).Key /= Right.Tree.Nodes (RNode).Key then + if Left.Nodes (LNode).Element /= + Right.Nodes (RNode).Element or + Left.Nodes (LNode).Key /= Right.Nodes (RNode).Key then exit; end if; - LNode := Next_Unchecked (Left, LNode); - RNode := Next_Unchecked (Right, RNode); + LNode := Next (Left, LNode); + RNode := Next (Right, RNode); end loop; return False; end Strict_Equal; @@ -1649,31 +1337,26 @@ package body Ada.Containers.Formal_Ordered_Maps is Element : in out Element_Type)) is begin - if Container.K /= Plain then - raise Constraint_Error - with "Can't modify part of container"; - end if; if not Has_Element (Container, Position) then raise Constraint_Error with "Position cursor of Update_Element has no element"; end if; - pragma Assert (Vet (Container.Tree.all, Position.Node), + pragma Assert (Vet (Container, Position.Node), "Position cursor of Update_Element is bad"); declare - T : Tree_Types.Tree_Type renames Container.Tree.all; - B : Natural renames T.Busy; - L : Natural renames T.Lock; + B : Natural renames Container.Busy; + L : Natural renames Container.Lock; begin B := B + 1; L := L + 1; declare - N : Node_Type renames T.Nodes (Position.Node); + N : Node_Type renames Container.Nodes (Position.Node); K : Key_Type renames N.Key; E : Element_Type renames N.Element; @@ -1723,7 +1406,7 @@ package body Ada.Containers.Formal_Ordered_Maps is -- Start of processing for Write begin - Write_Nodes (Stream, Container.Tree.all); + Write_Nodes (Stream, Container); end Write; procedure Write |