From: geert@fozzie.sun3.iaf.nl (Geert Bosch)
Subject: Reference-counted Unbounded_Lists package (LONG)
Date: 1996/11/08
Date: 1996-11-08T00:00:00+00:00 [thread overview]
Message-ID: <55u2u5$ngo@fozzie.sun3.iaf.nl> (raw)
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
reply other threads:[~1996-11-08 0:00 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox