-----------------------------------------------------------------------
--                               G P S                               --
--                                                                   --
--                 Copyright (C) 2007-2010, AdaCore                  --
--                                                                   --
-- GPS is free  software;  you can redistribute it and/or modify  it --
-- under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or --
-- (at your option) any later version.                               --
--                                                                   --
-- This program is  distributed in the hope that it will be  useful, --
-- but  WITHOUT ANY WARRANTY;  without even the  implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details. You should have received --
-- a copy of the GNU General Public License along with this program; --
-- if not,  write to the  Free Software Foundation, Inc.,  59 Temple --
-- Place - Suite 330, Boston, MA 02111-1307, USA.                    --
-----------------------------------------------------------------------

--  This package provides an annotation container - this is used to efficiently
--  add annotation without having to carry heavy containers. On the other hand,
--  it's not suitable for large number of annotations.

--  It is generic in order to allow the creation of incompatible annotations
--  types.

generic
package Annotations is

   type Annotation_Kind is
     (Nothing, Integer_Kind, Boolean_Kind, Other_Kind);

   type General_Annotation_Record is tagged null record;
   --  A general annotation record has to be derived by the implemented in
   --  order to store complex data structure.

   procedure Free
     (Obj : in out General_Annotation_Record) is null;
   --  This function will be called when the enclosing annotation if freed.
   --  The implementer is responsible of doing all the necessary deallocations
   --  here.

   type General_Annotation is access all General_Annotation_Record'Class;

   type Annotation (Kind : Annotation_Kind := Nothing) is record
      case Kind is
         when Nothing =>
            null;

         when Integer_Kind =>
            Integer_Val : Integer;

         when Boolean_Kind =>
            Boolean_Val : Boolean;

         when Other_Kind =>
            Other_Val : General_Annotation;
            --  This value will be freed when the tree containing the object
            --  is freed.
      end case;
   end record;

   procedure Free (Annot : in out Annotation);
   --  Free the given annotation, and its subsequent Other_Val if relevant.

   Null_Annotation : constant Annotation := (Kind => Nothing);

   type Annotation_Key is private;
   --  An annotation key is used to store and retreive an annotation from the
   --  container. Only one annotation can be stored in a given tree.

   Null_Annotation_Key : constant Annotation_Key;

   type Annotation_Key_Registry is private;
   --  A key registry holds the map of the created annotations keys, and
   --  ensures that the new created keys won't conflict with existing ones.
   --  All keys used for a given annotation container should come from a unique
   --  annotation key registry.

   function Create_Annotation_Key_Registry return Annotation_Key_Registry;
   --  Creates a new annotation key registry.

   procedure Free (Registry : in out Annotation_Key_Registry);
   --  Free the memory associated to this key registry.

   Null_Annotation_Key_Registry : constant Annotation_Key_Registry;

   procedure Get_Annotation_Key
     (Registry : in out Annotation_Key_Registry;
      New_Key  : out Annotation_Key);
   --  Creates a new key out of this registry.

   type Annotation_Container is private;
   --  Container for annoations. This container is potentially using a node for
   --  each annotation, even if they are not actually set. Accesses are
   --  extremely efficient, but if too many keys have been created from the
   --  registry, then memory will get lost.

   Null_Annotation_Container : constant Annotation_Container;

   procedure Free (Container : in out Annotation_Container);
   --  Free the memory associated to this container and its annotations.

   procedure Get_Annotation
     (Container : Annotation_Container;
      Key       : Annotation_Key;
      Result    : out Annotation);
   pragma Inline (Get_Annotation);
   --  Return the annotation located at the key given in parameter. If such an
   --  annotation doesn't exist, return Null_Annotation.

   procedure Set_Annotation
     (Container : in out Annotation_Container;
      Key       : Annotation_Key;
      Value     : Annotation);
   --  Set the value of an annotation. If there's already an annotation stored
   --  here, it will first be freed.

   function Is_Set
     (Container : Annotation_Container; Key : Annotation_Key)
      return Boolean;
   --  Return true if the annotation at the key given in parameter is set.

   procedure Free_Annotation
     (Container : Annotation_Container; Key : Annotation_Key);
   --  Free the annotation located at the key given in parameter, and replace
   --  its value by Null_Annotation in the container.

   function Copy (Obj : Annotation) return Annotation;
   --  Performs a deep copy of the annotation, including the "Other_Val" if
   --  any.

private

   type Annotation_Key is new Integer;

   Null_Annotation_Key : constant Annotation_Key := 0;

   type Annotation_Array is
     array (Annotation_Key range <>) of Annotation;

   type Annotation_Array_Access is access Annotation_Array;

   type Annotation_Key_Registry_Record is record
      Last_Key : Annotation_Key := 0;
   end record;

   type Annotation_Key_Registry is
     access all Annotation_Key_Registry_Record;

   Null_Annotation_Key_Registry : constant Annotation_Key_Registry := null;

   type Annotation_Container is record
      Annotations : Annotation_Array_Access;
   end record;

   Null_Annotation_Container : constant Annotation_Container :=
     (Annotations => null);

end Annotations;
