Re: Visibility issue

[Shark8 <onewingedshark@gmail.com>]

On Friday, September 11, 2020 at 4:37:29 AM UTC-6, Daniel wrote:
> Hello, 
> I want to use a tagged type as a link to communicate users of a library, in the way to make one part visible to them and also to hide some content that is only needed for the implementing of the library.

Here's how that's normally achieved; I've compiled the following but haven't written a testbed/driver:

-- Daniel.ads
Package Daniel with Pure is
   -- Base Interface which all API objects implement.
   Type Abstract_Base is interface;
   
   -- All common methods.
   Function As_String(Object : Abstract_Base) return String is abstract;
   
   -- All Classwide methods.
   Function Print( Object : Abstract_Base'Class ) return String;
   
   
   -- The Callback type.
   Type Callback is access
     procedure(Item : in out Abstract_Base'Class);
   
Private
   -- The classwide "Print" returns the given object's As_String result.
   Function Print( Object : Abstract_Base'Class ) return String is
      (Object.As_String);
End Daniel;

-----------------------------------------------
-- Daniel-Implementation.ads
With
Ada.Finalization,
Ada.Strings.Equal_Case_Insensitive,
Ada.Strings.Less_Case_Insensitive,
Ada.Containers.Indefinite_Ordered_Maps;

Private Package Daniel.Implementation with Preelaborate is
   -- Fwd decl.
   Type Implementation_Base(Name_Length : Positive) is tagged private;
   
   -- Implementation_Base and its descendents have a Name, that is within the
   -- private-portion of the implementation and therefore we need an accessor.
   -- Note: Name is unique and case-insensitive.
   Function Get_Name(Object: Implementation_Base'Class) Return String;

   -- Given a name, this retrieves the object; raises constraint-error if that
   -- name is not associated with an object.
   Function Make  (Name : String) return Implementation_Base'Class;
   Function Create(Name : String) return Implementation_Base;
   Function "="(Left, Right : Implementation_Base) return Boolean;
   
Private
   -- Full decl. Note, also, that this is hidden from the API package.
   Type Implementation_Base(Name_Length : Positive) is
     new Ada.Finalization.Controlled with record
      Name : String(1..Name_Length);
   End record;
   
   -- Finalization; this will remove the registered Name from the object-map.
   overriding
   procedure Finalize   (Object : in out Implementation_Base);

   -- Instantiate the package mapping Names to Objects.
   Package Name_Map is new Ada.Containers.Indefinite_Ordered_Maps(
         Key_Type     => String,
         Element_Type => Implementation_Base'Class,
         "<" => Ada.Strings.Less_Case_Insensitive,
         "=" => "="
        );
   
   -- This is the map that associates objects and their names.
   Core_Map : Name_Map.Map;
End Daniel.Implementation;

------------------------------------------------
-- Daniel-API.ads
Private With
Daniel.Implementation;

Private Package Daniel.API with Preelaborate is
   -- The base API-visable type.
   Type API_Base(<>) is new Abstract_Base with private;
   
   -- Creation functions.
   Function Create(Name : String) return API_Base;
   Function Create(Name : String; Op : Callback) return API_Base;
   
   -- Interface functions.
   Function As_String (Object :        API_Base) return String;
   Procedure Execute  (Object : in out API_Base);
Private
   -- We derive from implementation's base, and add a discriminant for the
   -- callback and another fata-field.
   Type API_Base( CBK : Callback; Length : Positive ) is
     new Daniel.Implementation.Implementation_Base( Name_Length => Length )
     and Abstract_Base with record
      A_1 : Character := 'C';
   end record;
   
   -- We raise an exception when there is no callback given.
   Function Create(Name : String) return API_Base is
     (raise Program_Error with "Callback MUST be specified.");
   
   -- Finally, we construct an object from a call to implementation's create
   -- and fill-in the missing information using an "extension aggrigate".
   Function Create(Name : String; Op : Callback) return API_Base is
     (Implementation.Create(Name) with
      CBK => Op, Length => Name'Length, others => <>);
   
End Daniel.API;

------------------------------------------------------------------------------
-- Daniel-Implementation.adb
with
Ada.Exceptions,
Ada.Finalization;

use
Ada.Finalization;

Package Body Daniel.Implementation is
   Function "=" (Left, Right : String) return Boolean
    renames Ada.Strings.Equal_Case_Insensitive;
   
   Function Get_Name(Object: Implementation_Base'Class) Return String is
     (Object.Name);

   Function Make(Name : String) return Implementation_Base'Class is
   Begin
      Return Core_Map(Name);
   Exception
      when PE : Program_Error =>
         raise Constraint_Error with Ada.Exceptions.Exception_Message(PE);
   End Make;

   Function "="(Left, Right : Implementation_Base) return boolean is
      (Left.Name = Right.Name);
   
   Function Create(Name : String) return Implementation_Base is
   begin
      Return Result : Constant Implementation_Base :=
        (Controlled with Name_Length => Name'Length, Name => Name) do
         Core_Map.Include(New_Item => Result, Key => Name);
      end return;
   end Create;
   
   Procedure Finalize(Object : in out Implementation_Base) is
   Begin
      Core_Map.Delete( Object.Name );
   End Finalize;
   
End Daniel.Implementation;

------------------------------------------------------
-- Daniel-API.adb
Package Body Daniel.API is
   Procedure Execute  (Object : in out API_Base) is
   Begin
      Object.CBK.All(Object);
   End Execute;

   Function As_String (Object : in API_Base) return String is
   Begin
      Return '(' & Object.Get_Name & ", " & Object.A_1 & ')';
   End As_String;
End Daniel.API;