----------------------------------------------------------------------------- -- -- libwww-ada95 : A World Wide Web client library for Ada95 -- -- U T I L . H A S H E D _ M A P P I N G -- -- B o d y -- -- Copyright (C) 1997-1998 Regents of the University of California -- -- libwww-ada95 is free software; you can redistribute it and/or modify it -- under the terms of the GNU General Public License as published by the Free -- Software Foundation, with or without the single exception listed below; -- either version 2, or (at your option) any later version. libwww-ada95 is -- distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; -- without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -- PARTICULAR PURPOSE. See the GNU General Public License for more details. -- You should have received a copy of the GNU General Public License -- distributed with libwww-ada95; see the file COPYING. If not, write to the -- Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -- -- As a special exception, if other files instantiate generics from this -- library, or you link this library with other files to produce an -- executable, this library does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU General Public License. -- -- Created in 1997 by Ron Kownacki and Kari Nies ----------------------------------------------------------------------------- with Unchecked_Deallocation; package body Util.Hashed_Mapping is function Equal (C1, C2 : Component) return boolean is begin return Equal (C1.Key, C2.Key); end Equal; -- Utilities: procedure Free is new Unchecked_Deallocation (Mapping_Rec, Mapping); function Make_General_Iter (Map : Mapping) return General_Iter; -- | Raises: uninitialized_Mapping -- | Effects: -- | Create and return a general Iterator based on map. Sets up -- | map, current and position fields as in the spec. -- | Raises uninitialized_Mapping iff map has not been initialized. function More (Iter : General_Iter) return boolean; -- | Effects: -- | Returns true iff the general Iter has not been exhausted, i.e., -- | returns not Is_Empty(Iter.position). procedure Advance (Iter : in out General_Iter; Comp : out Component); -- | Effects: -- | Advances Iter.position, and if necessary, Iter.current to the -- | next component, as detailed in the spec. Iter.position will -- | be empty if no more elements remain to be Iterated over. -- | Requires: -- | Iter.position is not null, i.e., caller has determined that Iter -- | was not exhausted before calling advance. -- Constructors: function Create return Mapping is -- | Effects: -- | Return {}. M : Mapping; begin return new Mapping_Rec'(Size => 0, Buckets => (Bucket_Range => Empty_List)); end Create; procedure Bind (Map : in out Mapping; Key : in Key_Type; Value : in Value_Type) is -- | Raises: Already_Bound, Uninitialized_Mapping -- | Effects: -- | Insert the binding, , into Map. Raises -- | Already_Bound iff a pair, , where Equal (key, k'), -- | is in map. -- | Raises Uninitialized_Mapping iff map has not been initialized. Idx : Bucket_Range := Hash (Key); C : Component := (Key => Key, Val => Value); begin if Is_In_List (Map.Buckets (Idx), C) then raise Already_Bound; end if; Append (Map.Buckets (Idx), C); Map.Size := Map.Size + 1; exception when CONSTRAINT_ERROR => -- null dereference raise Uninitialized_Mapping; end Bind; procedure Unbind (Map : in out Mapping; Key : in Key_Type) is -- | Raises: not_bound, Uninitialized_Mapping -- | Effects: -- | If , where equal (key, k), is in map, then removes -- | from map. Raises not_bound if no such pair exists. -- | Raises Uninitialized_Mapping iff map has not been initialized. Idx : Bucket_Range := Hash (Key); Tmpc : Component; begin Tmpc.Key := Key; -- don't need a Value, equality just tests Keys Delete_Item (Map.Buckets (Idx), Tmpc); Map.Size := Map.Size - 1; exception when Item_Not_Present => raise Not_Bound; when CONSTRAINT_ERROR => -- null dereference raise Uninitialized_Mapping; end Unbind; function Copy (Map : Mapping) return Mapping is -- | Raises: Uninitialized_Mapping -- | Effects: -- | Returns a copy of map. Subsequent changes to map will not be -- | visible through applying operations to the copy of map. -- | Assignment or parameter passing without copying will result -- | in a single mapping value being shared among mapping objects. -- | Raises Uninitialized_Mapping iff map has not been initialized. -- | The assignment operation is used to transfer the values of the -- | key_type and value_type type components of map; consequently, -- | changes in the values of these types may be observable through -- | both mappings if these are access types, or if they contain -- | components of an access type. New_Map : Mapping; begin if Map = null then raise Uninitialized_Mapping; end if; New_Map := new Mapping_Rec; New_Map.Size := Map.Size; for Idx in Bucket_Range loop New_Map.Buckets (Idx) := Copy (Map.Buckets (Idx)); end loop; return New_Map; end Copy; -- Query Operations: function Is_Empty (Map : Mapping) return boolean is -- | Raises: Uninitialized_Mapping -- | Effects: -- | Return map = {}. -- | Raises Uninitialized_Mapping iff map has not been initialized. begin return Map.Size = 0; exception when CONSTRAINT_ERROR => -- null dereference raise Uninitialized_Mapping; end Is_Empty; function Size (Map : Mapping) return natural is -- | Raises: Uninitialized_Mapping -- | Effects: -- | Return |map|, the number of bindings in map. -- | Raises Uninitialized_Mapping iff map has not been initialized. begin return Map.Size; exception when CONSTRAINT_ERROR => -- null dereference raise Uninitialized_Mapping; end Size; function Is_Bound (Map : Mapping; Key : Key_Type) return boolean is -- | Raises: Uninitialized_Mapping -- | Return true iff Equal (Key, K) for some in map. -- | Raises Uninitialized_Mapping iff map has not been initialized. Tmpc : Component; begin Tmpc.Key := Key; -- don't need a Value, equality just tests Keys return Is_In_List (Map.Buckets (Hash (Key)), Tmpc); exception when CONSTRAINT_ERROR => -- null dereference raise Uninitialized_Mapping; end Is_Bound; function Fetch (Map : Mapping; Key : Key_Type) return Value_Type is -- | Raises: Not_bound, Uninitialized_Mapping -- | If , where Equal (Key, K), is in Map, then return v. -- | Raises Not_Bound if no such exists. -- | Raises Uninitialized_Mapping iff map has not been initialized. Buck_Iter : List_Iterator := New_Iterator (Map.Buckets (Hash (Key))); Comp : Component; begin while More (Buck_Iter) loop Next (Buck_Iter, Comp); if Equal (Key, Comp.Key) then return Comp.Val; end if; end loop; raise Not_Bound; exception when CONSTRAINT_ERROR => -- null dereference raise Uninitialized_Mapping; end Fetch; -- Iterators: function Make_Keys_Iter (Map : Mapping) return Keys_Iter is -- | Raises: Uninitialized_Mapping -- | Effects: -- | Create and return a keys iterator based on map. This object -- | can then be used in conjunction with the more function and the -- | next procedure to iterate over all keys that are bound in map. -- | Raises Uninitialized_Mapping iff map has not been initialized. begin return Keys_Iter (Make_General_Iter (Map)); end Make_Keys_Iter; function More (Iter : Keys_Iter) return boolean is -- | Effects: -- | Return true iff the keys iterator has not been exhausted. begin return More (General_Iter (Iter)); end More; procedure Next (Iter : in out Keys_Iter; Key : out Key_Type) is -- | Raises: No_More -- | Effects: -- | Let Iter be based on the mapping, map. Successive calls of Next -- | will return the bound keys of map in some arbitrary order. -- | After all bound keys have been returned, then the procedure will -- | raise No_More. -- | Requires: -- | Map must not be changed between the invocations of -- | Make_Keys_Iterator (Map) and Next. Comp : Component; begin Advance (General_Iter (Iter), Comp); Key := Comp.Key; end Next; function Make_Values_Iter (Map : Mapping) return Values_Iter is -- | Raises: Uninitialized_Mapping -- | Effects: -- | Create and return a values iterator based on Map. This object -- | can then be used in conjunction with the more function and the -- | next procedure to iterate over all values that are bound to keys -- | in Map. -- | Raises Uninitialized_Mapping iff Map has not been initialized. begin return Values_Iter (Make_General_Iter (Map)); end Make_Values_Iter; function More (Iter : Values_Iter) return boolean is -- | Effects: -- | Return true iff the values iterator has not been exhausted. begin return More (General_Iter (Iter)); end More; procedure Next (Iter : in out Values_Iter; Val : out Value_Type) is -- | Raises: No_More -- | Effects: -- | Let Iter be based on the mapping, map. Successive calls of Next -- | will return the bound values of map in some arbitrary order. -- | After all bound values have been returned, then the procedure -- | will raise No_More. -- | Requires: -- | Map must not be changed between the invocations of -- | Make_Values_Iterator (Map) and Next. Comp : Component; begin Advance (General_Iter (Iter), Comp); Val := Comp.Val; end Next; function Make_Bindings_Iter (Map : Mapping) return Bindings_Iter is -- | Raises: Uninitialized_Mapping -- | Effects: -- | Create and return a bindings iterator based on map. This object -- | can then be used in conjunction with the more function and the -- | next procedure to iterate over all key/value pairs in map. -- | Raises Uninitialized_Mapping iff map has not been initialized. begin return Bindings_Iter (Make_General_Iter (Map)); end Make_Bindings_Iter; function More (Iter : Bindings_Iter) return boolean is -- | Effects: -- | Return true iff the bindings iterator has not been exhausted. begin return More (General_Iter (Iter)); end More; procedure Next (Iter : in out Bindings_Iter; Key : out Key_Type; Val : out Value_Type) is -- | Raises: No_More -- | Effects: -- | Let iter be based on the mapping, map. Successive calls of next -- | will return the key/value pairs of map in some arbitrary order. -- | After all such pairs have been returned, then the procedure will -- | raise No_More. -- | Requires: -- | Map must not be changed between the invocations of -- | Make_Bindings_Iterator (Map) and Next. Comp : Component; begin Advance (General_Iter (Iter), Comp); Key := Comp.Key; Val := Comp.Val; end Next; -- Heap management: procedure Destroy (M : in out Mapping) is -- | Effects: -- | Return space consumed by mapping value associated with object -- | M to the heap. (If M is uninitialized, this operation does -- | nothing.) If other objects share the same mapping value, the -- | further use of these objects is erroneous. Components of type -- | value_type, if they are access types, are not garbage collected. -- | It is the user's responsibility to dispose of these objects. -- | M is left in the uninitialized state. begin for I in Bucket_Range loop Destroy (M.Buckets (I)); end loop; Free (M); exception when CONSTRAINT_ERROR => -- M is null return; end Destroy; -- Utilities: -- create a general purpose iterator for the given Hash Table Mapping function Make_General_Iter (Map : Mapping) return General_Iter is Iter : General_Iter; begin if Map = null then raise Uninitialized_Mapping; end if; for Idx in Bucket_Range loop if not Is_Empty (Map.Buckets (Idx)) then Iter.Map := Map; Iter.Current := Idx; Iter.Position := New_Iterator (Map.Buckets (Idx)); return Iter; end if; end loop; Iter.Position := New_Iterator (Empty_List); -- no elements, makes next(Iter) false. return Iter; end Make_General_Iter; -- make the compiler happy with a procedure spec procedure Find_Non_Empty_Bucket (Iter : in General_Iter; Index : out Bucket_Range; Success : out boolean); -- Return index to next non empty bucket procedure Find_Non_Empty_Bucket (Iter : in General_Iter; Index : out Bucket_Range; Success : out boolean) is begin if Iter.Current /= Bucket_Range'Last then for Idx in Bucket_Range'Succ (Iter.Current) .. Bucket_Range'Last loop if not Is_Empty (Iter.Map.Buckets (Idx)) then Index := Idx; Success := true; return; end if; end loop; end if; Index := Bucket_Range'Last; Success := false; end Find_Non_Empty_Bucket; -- Returns whether or not the general iterator has been exhausted function More (Iter : General_Iter) return boolean is Idx : Bucket_Range; More_Comps : boolean; begin if More (Iter.Position) then return true; else Find_Non_Empty_Bucket (Iter, Idx, More_Comps); return More_Comps; end if; end More; -- Advance the iterator and return the next component procedure Advance (Iter : in out General_Iter; Comp : out Component) is Idx : Bucket_Range; More_Comps : boolean; begin if not More (Iter.Position) then Find_Non_Empty_Bucket (Iter, Idx, More_Comps); if not More_Comps then raise No_More; else Iter.Current := Idx; Iter.Position := New_Iterator (Iter.Map.Buckets (Idx)); end if; end if; Next (Iter.Position, Comp); end Advance; end Util.Hashed_Mapping;