Reference-counted Unbounded_Lists package (LONG)

Reference-counted Unbounded_Lists package (LONG)

[Geert Bosch]

As a result of the discussion last week about strings in Ada,
resp. Icon there was also a suggestion to have reference counted
strings and whether that would be faster than the standard
unbounded string application.

To test that I've written a generic package that implements 
reference-counted unbounded lists. The nice things is that
instantiation with Item => Character and List => String gives
an unbounded strings package. When defining this Unbounded_String
as a Line type, you could make a Text by making an unbounded list
of Lines. 

Currently no locking is implemented, so unbounded lists should
not be shared between tasks, although most operations are not
very sensitive to concurrent access.

Also the number of available operations is much lower than for 
unbounded strings, for example, but they are easy to add.
Since at this time the package is not too long I decided to post
it here for you to have a look at it. 

BTW, As for speed, this package is slightly faster than GNAT's
unbounded strings with my simple benchmark, but it depends on the
operations that are used. Bounded strings or lists are faster anyways.

Regards,
   Geert

-- Unbounded_Lists.ads
---------------------------------------------------------------------------
--
--  Unbounded_Lists                     (C) 1996 Geert Bosch
--
--  This package implements a generic Unbounded_List type that uses
--  reference counted dynamic memory management. Deallocation is
--  automatic and immediate.
--
--  Note that when instantiated as Unbounded_Lists(Character, String),
--  the result is comparable to Ada.Strings.Unbounded. The speed should
--  also be approximately the same, except for assignments which are much
--  faster.
--
--
--  This program distribution is intended mainly for educational
--  purposes and comes without any warranties. You may use this
--  package under these conditions:
--
--  (1) You may not sell the package or include it in a commercial product
--  (2) If you modify any of the packages and distribute them
--      further, you may add your name and other identifying
--      info to the comment block at the top of the program,
--      but must otherwise leave the comment block unchanged.
--
--  For any comments and questions send e-mail to geert@sun3.iaf.nl
--
--         Author:  Geert Bosch (geert@sun3.iaf.nl)
--  Last modified:  8 Nov '96
---------------------------------------------------------------------------

with Ada.Finalization;
generic
   type Item is private;
   type List is array (Positive range <>) of Item;
package Unbounded_Lists is

   type Unbounded_List is private;

   Null_Unbounded_List : constant Unbounded_List;

   function Length (Source : Unbounded_List) return Natural;

   -------------------------------------------
   -- Construction and Conversion functions --
   -------------------------------------------

   function Create (Value : List) return Unbounded_List;
   function Create (Length : Natural) return Unbounded_List;
   function To_List (Source : Unbounded_List) return List;

   -----------------------------
   -- Concatenation Functions --
   -----------------------------

   procedure Append
     (Source   : in out Unbounded_List;
      New_Item : in Unbounded_List);

   procedure Append
     (Source   : in out Unbounded_List;
      New_Item : in List);

   procedure Append
     (Source   : in out Unbounded_List;
      New_Item : in Item);

   function "&" (Left, Right : Unbounded_List) return Unbounded_List;

   function "&"
     (Left  : in Unbounded_List;
      Right : in List)
      return  Unbounded_List;

   function "&"
     (Left  : in List;
      Right : in Unbounded_List)
      return  Unbounded_List;

   function "&"
     (Left  : in Unbounded_List;
      Right : in Item)
      return  Unbounded_List;

   function "&"
     (Left  : in Item;
      Right : in Unbounded_List)
      return  Unbounded_List;

   -------------------------
   -- Selection Functions --
   -------------------------

   function Element
     (Source : in Unbounded_List;
      Index  : in Positive)
      return Item;

   procedure Replace_Element
     (Source : in out Unbounded_List;
      Index  : in Positive;
      By     : in Item);

   function Slice
     (Source : in Unbounded_List;
      Low    : in Positive;
      High   : in Natural)
      return   List;

private

   --  Inline some small often-used subprograms for speed
   pragma Inline (Length);
   pragma Inline (Create);
   pragma Inline (To_List);

   type List_Access is access List;

   --  Indirect reference counting pointer
   type Ref_Count is record
      Count   : Natural := 1;
      Pointer : List_Access;
   end record;

   type Ref_Count_Ptr is access Ref_Count;

   --  Controlled type that maintains the reference count
   --  and deallocates memory when it becomes unreferenced
   type Unbounded_List is new Ada.Finalization.Controlled with record
      Reference : Ref_Count_Ptr;
   end record;

   procedure Initialize (Object : in out Unbounded_List);
   procedure Adjust     (Object : in out Unbounded_List);
   procedure Finalize   (Object : in out Unbounded_List);

   function Create (Reference : Ref_Count_Ptr) return Unbounded_List;
   pragma Inline (Create);

   --  Initialize Count to 1 to prevent deallocation
   Null_Unbounded_List : constant Unbounded_List :=
     (Ada.Finalization.Controlled with
      Reference => new Ref_Count'(Count => 1, Pointer => new List (1 .. 0)));

end Unbounded_Lists;

-- Unbounded_Lists.adb
with Unchecked_Deallocation;
package body Unbounded_Lists is

   procedure Free is new Unchecked_Deallocation (List, List_Access);
   procedure Free is new Unchecked_Deallocation (Ref_Count, Ref_Count_Ptr);

   --------------------------
   -- Conversion functions --
   --------------------------

   function Create (Length : Natural) return Unbounded_List is
      Ptr       : List_Access := new List (1 .. Length);
   begin
      return Create (new Ref_Count' (Count   => 1, Pointer => Ptr));
   end Create;


   function Create
     (Reference : Ref_Count_Ptr) return Unbounded_List is
   begin
      return Unbounded_List'(Ada.Finalization.Controlled with Reference);
   end Create;

   function Create (Value : List) return Unbounded_List is
   begin
      return Create (new Ref_Count'
        (Count => 1, Pointer => new List'(Value)));
   end Create;

   function To_List (Source : Unbounded_List) return List is
   begin
      return Source.Reference.Pointer.all;
   end To_List;

   function Length (Source : Unbounded_List) return Natural is
   begin
      return Source.Reference.Pointer'Length;
   end Length;

   --------------------------------------------
   -- Concatenation, and Selection Functions --
   --------------------------------------------

   procedure Append
     (Source   : in out Unbounded_List;
      New_Item : in Unbounded_List) is
   begin
      Source := Source & New_Item;
   end Append;

   procedure Append
     (Source   : in out Unbounded_List;
      New_Item : in List) is
   begin
      Source := Source & New_Item;
   end Append;

   procedure Append
     (Source   : in out Unbounded_List;
      New_Item : in Item) is
   begin
      Source := Source & New_Item;
   end Append;

   function "&" (Left, Right : Unbounded_List) return Unbounded_List is
      LL        : Natural := Length (Left);
      LR        : Natural := Length (Right);
      Result    : Unbounded_List := Create (LL + LR);
   begin
      Result.Reference.Pointer (1 .. LL) := Left.Reference.Pointer.all;
      Result.Reference.Pointer (LL + 1 .. LL + LR)
         := Right.Reference.Pointer.all;
      return Result;
   end "&";

   function "&"
     (Left  : in Unbounded_List;
      Right : in List)
      return  Unbounded_List
   is
      LL        : Natural := Length (Left);
      LR        : Natural := Right'Length;
      Result    : Unbounded_List := Create (LL + LR);
   begin
      Result.Reference.Pointer (1 .. LL) := To_List (Left);
      Result.Reference.Pointer (LL + 1 .. LL + LR) := Right;
      return Result;
   end "&";

   function "&"
     (Left  : in List;
      Right : in Unbounded_List)
      return  Unbounded_List
   is
      LL        : Natural := Left'Length;
      LR        : Natural := Length (Right);
      Result    : Unbounded_List := Create (LL + LR);
   begin
      Result.Reference.Pointer (1 .. LL) := Left;
      Result.Reference.Pointer (LL + 1 .. LL + LR) := To_List (Right);
      return Result;
   end "&";

   function "&"
     (Left  : in Unbounded_List;
      Right : in Item)
      return  Unbounded_List is
   begin
      return Left & List'(1 => Right);
   end "&";

   function "&"
     (Left  : in Item;
      Right : in Unbounded_List)
      return  Unbounded_List is
   begin
      return List'(1 => Left) & Right;
   end "&";

   -------------------------
   -- Selection Functions --
   -------------------------

   function Slice
     (Source    : Unbounded_List;
      Low       : Positive;
      High      : Natural) return List is
   begin
      return Source.Reference.Pointer (Low .. High);
   end Slice;

   function Element
     (Source    : in Unbounded_List;
      Index     : in Positive) return Item is
   begin
      return Source.Reference.Pointer (Index);
   end Element;

   procedure Replace_Element
     (Source    : in out Unbounded_List;
      Index     : in Positive;
      By        : in Item)
   is
   begin
      --  Here should be locking
      if Source.Reference.Count > 1 then
         Source := Create (To_List (Source)); --  Copy
      end if;
      Source.Reference.Pointer (Index) := By;
   end Replace_Element;

   ------------------------------------
   -- Controlled Type implementation --
   ------------------------------------

   procedure Initialize (Object : in out Unbounded_List) is
   begin
      Object.Reference := Null_Unbounded_List.Reference;
      Object.Reference.Count := Object.Reference.Count + 1;
   end Initialize;

   procedure Adjust (Object : in out Unbounded_List) is
   begin
      Object.Reference.Count := Object.Reference.Count + 1;
   end Adjust;

   procedure Finalize (Object : in out Unbounded_List) is
   begin
      Object.Reference.Count := Object.Reference.Count - 1;
      if Object.Reference.Count = 0 then
         Free (Object.Reference.Pointer);
         Free (Object.Reference);
      end if;
   end Finalize;

end Unbounded_Lists;

-- 
E-Mail: geert@sun3.iaf.nl