----------------------------------------------------------------------------- -- -- libwww-ada95 : A World Wide Web client library for Ada95 -- -- U T I L . L L I S T S -- -- 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 Kari Nies ----------------------------------------------------------------------------- with Unchecked_Deallocation; package body Util.LLists is procedure Free is new Unchecked_Deallocation (Cell, Cell_Ptr); -- make compiler happy procedure Find_Item (L : in List; I : in Item_Type; Prev : out Cell_Ptr; Loc : out Cell_Ptr); ------------------------------------------------ -- Insert item I at beginning of list L ------------------------------------------------ procedure Insert (L : in out List; I : Item_Type) is New_Cell : Cell_Ptr := new Cell'(I, L.First); begin L.First := New_Cell; if L.Last = null then L.Last := New_Cell; end if; L.Length := L.Length + 1; end Insert; ------------------------------------------------ -- Append item I to end of list L ------------------------------------------------ procedure Append (L : in out List; I : Item_Type) is New_Cell : Cell_Ptr := new Cell'(I, null); begin if L.First = null then -- list is empty L.First := New_Cell; L.Last := New_Cell; else L.Last.Next := New_Cell; L.Last := New_Cell; end if; L.Length := L.Length + 1; end Append; ------------------------------------------------ -- Append L2 to the end of L1. does not copy. -- L2 is reset to be empty. ------------------------------------------------ procedure Append (L1 : in out List; L2 : in out List) is begin if L2.First /= null then if L1.First = null then -- L1 is empty L1.First := L2.First; L1.Last := L2.Last; else L1.Last.Next := L2.First; L1.Last := L2.Last; end if; L1.Length := L1.Length + L2.Length; L2.First := null; L2.Last := null; L2.Length := 0; end if; end Append; --------------------------------------------------------- -- Search for Item I in List L. If found, return -- ptr to the cell containing the item (Loc) as well as -- a ptr to the previous cell for possible deletion (Prev). -- Otherwise, both Loc and Prev are null. --------------------------------------------------------- procedure Find_Item (L : in List; I : in Item_Type; Prev : out Cell_Ptr; Loc : out Cell_Ptr) is begin Loc := L.First; Prev := null; while Loc /= null loop if Equal (Loc.Info, I) then return; end if; Prev := Loc; Loc := Loc.Next; end loop; end Find_Item; ------------------------------------------------ -- Removes the first item of the list equal to I ------------------------------------------------ procedure Delete_Item (L : in out List; I : in Item_Type) is Prev, Ptr : Cell_Ptr; begin Find_Item (L, I, Prev, Ptr); if Ptr = null then raise Item_Not_Present; end if; if Ptr = L.First then L.First := L.First.Next; else Prev.Next := Ptr.Next; end if; if Ptr = L.Last then L.Last := Prev; end if; Free (Ptr); end Delete_Item; ------------------------------------------------ -- Returns the number of items in the given list ------------------------------------------------ function Length (L : List) return NATURAL is begin return L.Length; end Length; ------------------------------------------------ -- Queries if the given list is empty ------------------------------------------------ function Is_Empty (L : List) return BOOLEAN is begin return L.First = null; end Is_Empty; ------------------------------------------------ -- Queries if the item I is in the list L. ------------------------------------------------ function Is_In_List (L : List; I : Item_Type) return boolean is Prev, Ptr : Cell_Ptr; begin Find_Item (L, I, Prev, Ptr); return Ptr /= null; end Is_In_List; ------------------------------------------------ -- Copies the contents of L to a new list ------------------------------------------------ function Copy (L : in List) return List is New_L : List; L_Iter : List_Iterator := New_Iterator (L); Ptr : Cell_Ptr; begin New_L.Length := L.Length; if L.Length > 0 then Ptr := new Cell; New_L.First := Ptr; Next (L_Iter, Ptr.Info); while More (L_Iter) loop Ptr.Next := new Cell; Ptr := Ptr.Next; Next (L_Iter, Ptr.Info); end loop; New_L.Last := Ptr; end if; return New_L; end Copy; ------------------------------------------------ -- Deallocates all items in a list; ------------------------------------------------ procedure Destroy (L : in out List) is Ptr : Cell_Ptr := L.First; Hold_Ptr : Cell_Ptr; begin while Ptr /= null loop Hold_Ptr := Ptr; Ptr := Ptr.Next; Free (Hold_Ptr); end loop; L.First := null; L.Last := null; L.Length := 0; end Destroy; ------------------------------------------------ -- Create a new iterator for list L ------------------------------------------------ function New_Iterator (L : List) return List_Iterator is begin return List_Iterator (L.First); end New_Iterator; ------------------------------------------------ -- Query if the given iterator is exhausted ------------------------------------------------ function More (LI : List_Iterator) return BOOLEAN is begin return LI /= null; end More; ------------------------------------------------ -- Advance the given iterator and return the -- next item. ------------------------------------------------ procedure Next (LI : in out List_Iterator; I : out Item_Type) is begin if LI = null then raise No_More_Items; end if; I := LI.Info; LI := List_Iterator (LI.Next); end Next; end Util.LLists;