------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, 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 Immutable_Reference) is
begin
if Object.Count /= null then
Object.Count.Increment;
end if;
end Adjust;
overriding procedure Finalize (Object : in out Immutable_Reference) is
procedure Free is
new Ada.Unchecked_Deallocation (Held_Data, Data_Access);
procedure Free is
new Ada.Unchecked_Deallocation (Counter, Counter_Access);
Deallocate : Boolean;
begin
if Object.Count /= null then
Object.Count.Decrement (Deallocate);
if Deallocate 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 Immutable_Reference is
begin
return (Ada.Finalization.Controlled with
Data => new Held_Data'(Constructor.all),
Count => new Counter);
end Create;
procedure Replace
(Ref : in out Immutable_Reference;
Constructor : not null access function return Held_Data) is
begin
Finalize (Ref);
Ref.Data := new Held_Data'(Constructor.all);
Ref.Count := new Counter;
end Replace;
function Create (Data : in Data_Access) return Immutable_Reference is
begin
if Data = null then
return Null_Immutable_Reference;
else
return (Ada.Finalization.Controlled with
Data => Data,
Count => new Counter);
end if;
end Create;
procedure Replace
(Ref : in out Immutable_Reference;
Data : in Data_Access) is
begin
Finalize (Ref);
if Data /= null then
Ref.Data := Data;
Ref.Count := new Counter;
end if;
end Replace;
procedure Reset (Ref : in out Immutable_Reference) is
begin
Finalize (Ref);
end Reset;
function Is_Empty (Ref : Immutable_Reference) return Boolean is
begin
return Ref.Count = null;
end Is_Empty;
function "=" (Left, Right : Immutable_Reference) return Boolean is
begin
return Left.Data = Right.Data;
end "=";
----------------------
-- Dereferenciation --
----------------------
function Query (Ref : in Immutable_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 Immutable_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;
------------------------
-- Counter Management --
------------------------
protected body Counter is
procedure Increment is
begin
Value := Value + 1;
end Increment;
procedure Decrement (Zero : out Boolean) is
begin
Value := Value - 1;
Zero := Value = 0;
end Decrement;
function Get_Value return Natural is
begin
return Value;
end Get_Value;
end Counter;
end Natools.References;