Natools

Artifact 440d4176078fd2c769e61141c0e5bae327a8a0a1:

• File src/natools-references__protected.adb — part of check-in [610b834d9d] at 2014-08-24 20:31:35 on branch trunk — references: add Is_Last primitive

  It's almost a break in abstraction, and it's unsafe to use when the reference can be accessed concurrently. However it might have some use in some context, to free the last reference when checked in a protected or thread-local context, to build a crude garbage collection system. (user: nat, size: 5078) [annotate] [blame] [check-ins using]

------------------------------------------------------------------------------
-- 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 Is_Last (Ref : Immutable_Reference) return Boolean is
   begin
      return Ref.Count.Get_Value = 1;
   end Is_Last;


   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;