ADDED src/natools-references.adb Index: src/natools-references.adb ================================================================== --- src/natools-references.adb +++ src/natools-references.adb @@ -0,0 +1,129 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +package body Natools.References is + + --------------------------------- + -- Low-level memory management -- + --------------------------------- + + overriding procedure Adjust (Object : in out Reference) is + begin + if Object.Count /= null then + Object.Count.all := Object.Count.all + 1; + end if; + end Adjust; + + + overriding procedure Finalize (Object : in out Reference) is + procedure Free is + new Ada.Unchecked_Deallocation (Held_Data, Data_Access); + procedure Free is + new Ada.Unchecked_Deallocation (Counter, Counter_Access); + begin + if Object.Count /= null then + Object.Count.all := Object.Count.all - 1; + + if Object.Count.all = 0 then + Free (Object.Count); + Free (Object.Data); + else + Object.Count := null; + Object.Data := null; + end if; + end if; + end Finalize; + + + + ----------------------------------------- + -- Object construction and destruction -- + ----------------------------------------- + + function Create + (Constructor : not null access function return Held_Data) + return Reference is + begin + return (Ada.Finalization.Controlled with + Data => new Held_Data'(Constructor.all), + Count => new Counter'(1)); + end Create; + + + procedure Replace + (Ref : in out Reference; + Constructor : not null access function return Held_Data) is + begin + Finalize (Ref); + Ref.Data := new Held_Data'(Constructor.all); + Ref.Count := new Counter'(1); + end Replace; + + + procedure Reset (Ref : in out Reference) is + begin + Finalize (Ref); + end Reset; + + + function Is_Empty (Ref : Reference) return Boolean is + begin + return Ref.Count = null; + end Is_Empty; + + + function "=" (Left, Right : Reference) return Boolean is + begin + return Left.Data = Right.Data; + end "="; + + + + ---------------------- + -- Dereferenciation -- + ---------------------- + + function Query (Ref : in Reference) return Accessor is + begin + return Accessor'(Data => Ref.Data, Parent => Ref); + end Query; + + + function Update (Ref : in Reference) return Mutator is + begin + return Mutator'(Data => Ref.Data, Parent => Ref); + end Update; + + + procedure Query + (Ref : in Reference; + Process : not null access procedure (Object : in Held_Data)) is + begin + Process.all (Ref.Data.all); + end Query; + + + procedure Update + (Ref : in Reference; + Process : not null access procedure (Object : in out Held_Data)) is + begin + Process.all (Ref.Data.all); + end Update; + +end Natools.References; + ADDED src/natools-references.ads Index: src/natools-references.ads ================================================================== --- src/natools-references.ads +++ src/natools-references.ads @@ -0,0 +1,111 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.References implements reference-counted smart pointer to any -- +-- type of objects. -- +-- This is a basic implementation that does not support weak references or -- +-- concurrency. However since there is no internal state, operations on -- +-- non-overlapping objects should be thread-safe. -- +------------------------------------------------------------------------------ + +with Ada.Finalization; + +generic + type Held_Data (<>) is limited private; + +package Natools.References is + pragma Preelaborate (References); + + type Reference is new Ada.Finalization.Controlled with private; + + type Accessor (Data : not null access constant Held_Data) is + limited private; + type Mutator (Data : not null access Held_Data) is + limited private; + + + function Create + (Constructor : not null access function return Held_Data) + return Reference; + -- Create a new held object and return a reference to it + + procedure Replace + (Ref : in out Reference; + Constructor : not null access function return Held_Data); + -- Replace the object held in Ref with a newly created object + + procedure Reset (Ref : in out Reference); + -- Empty Ref + + function Is_Empty (Ref : Reference) return Boolean; + -- Check whether Ref refers to an actual object + + function "=" (Left, Right : Reference) return Boolean; + -- Check whether Left and Right refer to the same object + + + function Query (Ref : in Reference) return Accessor; + pragma Inline (Query); + -- Return a derefenciable constant access to the held object + + function Update (Ref : in Reference) return Mutator; + pragma Inline (Update); + -- Return a derefenciable mutable access to the held object + + procedure Query + (Ref : in Reference; + Process : not null access procedure (Object : in Held_Data)); + -- Call Process with the held object + + procedure Update + (Ref : in Reference; + Process : not null access procedure (Object : in out Held_Data)); + -- Call Process with the held object + + Null_Reference : constant Reference; + +private + + type Counter is new Natural; + + type Counter_Access is access Counter; + + type Data_Access is access Held_Data; + + type Reference is new Ada.Finalization.Controlled with record + Count : Counter_Access := null; + Data : Data_Access := null; + end record; + + overriding procedure Adjust (Object : in out Reference); + -- Increate reference counter + + overriding procedure Finalize (Object : in out Reference); + -- Decrease reference counter and release memory if needed + + type Accessor (Data : not null access constant Held_Data) is limited record + Parent : Reference; + end record; + + type Mutator (Data : not null access Held_Data) is limited record + Parent : Reference; + end record; + + Null_Reference : constant Reference + := (Ada.Finalization.Controlled with Count => null, Data => null); + +end Natools.References;