diff options
Diffstat (limited to 'gcc/ada/a-coorma.adb')
| -rw-r--r-- | gcc/ada/a-coorma.adb | 180 |
1 files changed, 156 insertions, 24 deletions
diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb index ba865202d24..c1ae68297b3 100644 --- a/gcc/ada/a-coorma.adb +++ b/gcc/ada/a-coorma.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -37,6 +37,24 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys); package body Ada.Containers.Ordered_Maps is + type Iterator is new + Map_Iterator_Interfaces.Reversible_Iterator with record + Container : Map_Access; + Node : Node_Access; + end record; + + overriding function First (Object : Iterator) return Cursor; + + overriding function Last (Object : Iterator) return Cursor; + + overriding function Next + (Object : Iterator; + Position : Cursor) return Cursor; + + overriding function Previous + (Object : Iterator; + Position : Cursor) return Cursor; + ----------------------------- -- Node Access Subprograms -- ----------------------------- @@ -249,8 +267,7 @@ package body Ada.Containers.Ordered_Maps is -- Clear -- ----------- - procedure Clear is - new Tree_Operations.Generic_Clear (Delete_Tree); + procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree); procedure Clear (Container : in out Map) is begin @@ -266,6 +283,18 @@ package body Ada.Containers.Ordered_Maps is return Node.Color; end Color; + ------------------------ + -- Constant_Reference -- + ------------------------ + + function Constant_Reference + (Container : Map; + Key : Key_Type) return Constant_Reference_Type + is + begin + return (Element => Container.Element (Key)'Unrestricted_Access); + end Constant_Reference; + -------------- -- Contains -- -------------- @@ -436,13 +465,23 @@ package body Ada.Containers.Ordered_Maps is function First (Container : Map) return Cursor is T : Tree_Type renames Container.Tree; - begin if T.First = null then return No_Element; + else + return Cursor'(Container'Unrestricted_Access, T.First); end if; + end First; - return Cursor'(Container'Unrestricted_Access, T.First); + function First (Object : Iterator) return Cursor is + M : constant Map_Access := Object.Container; + N : constant Node_Access := M.Tree.First; + begin + if N = null then + return No_Element; + else + return Cursor'(Object.Container.all'Unchecked_Access, N); + end if; end First; ------------------- @@ -455,9 +494,9 @@ package body Ada.Containers.Ordered_Maps is begin if T.First = null then raise Constraint_Error with "map is empty"; + else + return T.First.Element; end if; - - return T.First.Element; end First_Element; --------------- @@ -466,13 +505,12 @@ package body Ada.Containers.Ordered_Maps is function First_Key (Container : Map) return Key_Type is T : Tree_Type renames Container.Tree; - begin if T.First = null then raise Constraint_Error with "map is empty"; + else + return T.First.Key; end if; - - return T.First.Key; end First_Key; ----------- @@ -481,13 +519,12 @@ package body Ada.Containers.Ordered_Maps is function Floor (Container : Map; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key); - begin if Node = null then return No_Element; + else + return Cursor'(Container'Unrestricted_Access, Node); end if; - - return Cursor'(Container'Unrestricted_Access, Node); end Floor; ---------- @@ -664,7 +701,8 @@ package body Ada.Containers.Ordered_Maps is ------------------------ function Is_Equal_Node_Node - (L, R : Node_Access) return Boolean is + (L, R : Node_Access) return Boolean + is begin if L.Key < R.Key then return False; @@ -686,7 +724,7 @@ package body Ada.Containers.Ordered_Maps is Right : Node_Access) return Boolean is begin - -- k > node same as node < k + -- Left > Right same as Right < Left return Right.Key < Left; end Is_Greater_Key_Node; @@ -744,6 +782,24 @@ package body Ada.Containers.Ordered_Maps is B := B - 1; end Iterate; + function Iterate + (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class + is + Node : constant Node_Access := Container.Tree.First; + It : constant Iterator := (Container'Unrestricted_Access, Node); + + begin + return It; + end Iterate; + + function Iterate (Container : Map; Start : Cursor) + return Map_Iterator_Interfaces.Reversible_Iterator'class + is + It : constant Iterator := (Container'Unrestricted_Access, Start.Node); + begin + return It; + end Iterate; + --------- -- Key -- --------- @@ -767,13 +823,23 @@ package body Ada.Containers.Ordered_Maps is function Last (Container : Map) return Cursor is T : Tree_Type renames Container.Tree; - begin if T.Last = null then return No_Element; + else + return Cursor'(Container'Unrestricted_Access, T.Last); end if; + end Last; - return Cursor'(Container'Unrestricted_Access, T.Last); + function Last (Object : Iterator) return Cursor is + M : constant Map_Access := Object.Container; + N : constant Node_Access := M.Tree.Last; + begin + if N = null then + return No_Element; + else + return Cursor'(Object.Container.all'Unchecked_Access, N); + end if; end Last; ------------------ @@ -782,13 +848,12 @@ package body Ada.Containers.Ordered_Maps is function Last_Element (Container : Map) return Element_Type is T : Tree_Type renames Container.Tree; - begin if T.Last = null then raise Constraint_Error with "map is empty"; + else + return T.Last.Element; end if; - - return T.Last.Element; end Last_Element; -------------- @@ -797,13 +862,12 @@ package body Ada.Containers.Ordered_Maps is function Last_Key (Container : Map) return Key_Type is T : Tree_Type renames Container.Tree; - begin if T.Last = null then raise Constraint_Error with "map is empty"; + else + return T.Last.Key; end if; - - return T.Last.Key; end Last_Key; ---------- @@ -867,6 +931,18 @@ package body Ada.Containers.Ordered_Maps is end; end Next; + function Next + (Object : Iterator; + Position : Cursor) return Cursor + is + begin + if Position.Node = null then + return No_Element; + else + return (Object.Container, Tree_Operations.Next (Position.Node)); + end if; + end Next; + ------------ -- Parent -- ------------ @@ -907,6 +983,17 @@ package body Ada.Containers.Ordered_Maps is end; end Previous; + function Previous + (Object : Iterator; + Position : Cursor) return Cursor + is + begin + if Position.Node = null then + return No_Element; + else + return (Object.Container, Tree_Operations.Previous (Position.Node)); + end if; + end Previous; ------------------- -- Query_Element -- ------------------- @@ -1000,6 +1087,35 @@ package body Ada.Containers.Ordered_Maps is raise Program_Error with "attempt to stream map cursor"; end Read; + procedure Read + (Stream : not null access Root_Stream_Type'Class; + Item : out Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Read; + + procedure Read + (Stream : not null access Root_Stream_Type'Class; + Item : out Constant_Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Read; + + --------------- + -- Reference -- + --------------- + + function Reference + (Container : Map; + Key : Key_Type) + return Reference_Type + is + begin + return (Element => Container.Element (Key)'Unrestricted_Access); + end Reference; + ------------- -- Replace -- ------------- @@ -1081,7 +1197,7 @@ package body Ada.Containers.Ordered_Maps is B : Natural renames Container.Tree'Unrestricted_Access.all.Busy; - -- Start of processing for Reverse_Iterate + -- Start of processing for Reverse_Iterate begin B := B + 1; @@ -1241,4 +1357,20 @@ package body Ada.Containers.Ordered_Maps is raise Program_Error with "attempt to stream map cursor"; end Write; + procedure Write + (Stream : not null access Root_Stream_Type'Class; + Item : Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Write; + + procedure Write + (Stream : not null access Root_Stream_Type'Class; + Item : Constant_Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Write; + end Ada.Containers.Ordered_Maps; |