Record containing access to instantiation of generic package based on that record

Question

This is really an annoying problem. I have a record type that wraps various base types and now I need it to be able to store a vector (from Ada.Containers.Vectors) in itself! I guess that's not possible but can anyone give me advice on how to solve this problem in another way perhaps? To give you a better idea of what I'm up to, here is what does not work:

with Base_Types; use Base_Types;
with Ada.Strings.Wide_Unbounded; use Ada.Strings.Wide_Unbounded;
with Ada.Containers.Vectors;
with Green_Tasks; use Green_Tasks;
with Ada.Unchecked_Deallocation;

package Boxed_Types is

   type String_Ptr is access Unbounded_Wide_String;
   procedure Free_Unbounded_Wide_String is new Ada.Unchecked_Deallocation
     (Object => Unbounded_Wide_String, Name => String_Ptr);
   type Vector_Ptr; -- this won't work

   type Type_T is (T_Null, T_UInt64, T_Text, T_Bool, T_GTask, T_Vector);
   type Item (IType : Type_T := T_Null) is record
      case IType is
         when T_Null   => null;
         when T_UInt64 => UInt64      : UInteger_64;
         when T_Text   => String      : String_Ptr;
         when T_Bool   => Bool        : Boolean;
         when T_GTask  => Green_Task  : Green_Task_Ptr;
         when T_Vector => Item_Vector : Vector_Ptr;     -- error here 
      end case;
   end record;

   package Item_Vectors is new Ada.Containers.Vectors
     (Index_Type   => Natural,
      Element_Type => Item);
   use Item_Vectors;
   type Vector_Ptr is access Vector;
end Boxed_Types;

This gives me the not so unexpected error "invalid use of type before it's full declaration" for Vector_Ptr. However, I cannot instantiate the vector package before I have declared Item either, and I really need the vector and the base types wrapped into one record type. (It's for Interpreter I'm writing in my spare time; the VM must store various different types on the stack, in heterogenous arrays, manipulate them, etc..)

Will I have to break type safety entirely and mess around with address to access conversions or is there a cleaner solution?

Answer 1

I Suspect Shark8 has the answer you are looking for. And brian drummond just posted a similar option to mine!.

However, as a completely different approach, you could try (not compiled, ada-like pseudo code):

FILE Boxed_Types.ads:

type item is tagged null record;

type item_ptr is access all item'Class;

package Item_Vectors is new Ada.Containers.Vectors
  ( Index_Type   => Natural,
    Element_Type => item_ptr -- Actually you may have to wrap this in a record type and possibly make it a controlled type.
  );    

procedure foo (object : in item'Class) is abstract;

FILE: boxed_types.uint64.adb (or pick your own sensible name):

type T_uint64 is new item with record
  UInt64      : Interfaces.Unsigned_64;
end record;

procedure foo (object : in T_uint64);

Repeat for other elements in your original record.

This would mean you can declare class-wide objects and use dynamic dispatching:

declare
   Obj : Boxed_Types.Item'Class := ...; 
begin
   Boxed_Types.foo; -- dynamic dispatching
end;

This should get around the issue of Item containing Item and have a further advantage of not having to interrogate the type before acting on its data fields!

Answer 2

Here's a different version which stores the Item (not its access) in the Vector. It works by using inheritance, creating a Vector of a base type. That implies an Indefinite_Vector because the size of each individual component is not known in advance.

Again, compiled but untested.

with Ada.Containers.Indefinite_Vectors;

package Boxed_Base is

   type Base_Item is tagged record
      null;
   end record;

   package Item_Vectors is new Ada.Containers.Indefinite_Vectors
     (Index_Type   => Natural,
      Element_Type => Base_Item'Class);
   use Item_Vectors;

   type Vector_Ptr is access Vector;

end Boxed_Base;

This base type has the property that it can be stored in the vector, and have its storage management handled by Indefinite_Vectors. Now we can inherit from it, with the characteristics we need.

with Ada.Strings.Wide_Unbounded; use Ada.Strings.Wide_Unbounded;
with Ada.Unchecked_Deallocation;
with Boxed_Base;

package Boxed_Types is

   type UInteger_64 is new integer;
   type Green_Task_Ptr is access UInteger_64;
   -- these two because original testcase was incomplete

   type String_Ptr is access Unbounded_Wide_String;
   type Type_T is (T_Null, T_UInt64, T_Text, T_Bool, T_GTask, T_Vector);

   type Item (IType : Type_T ) is new Boxed_Base.Base_Item with record
      case IType is
         when T_Null   => null;
         when T_UInt64 => UInt64      : UInteger_64;
         when T_Text   => String      : String_Ptr;
         when T_Bool   => Bool        : Boolean;
         when T_GTask  => Green_Task  : Green_Task_Ptr;
         when T_Vector => Item_Vector : Boxed_Base.Vector_Ptr;    
      end case;
   end record;

end Boxed_Types;

One feature of the original design has gone : the default discriminant is not allowed for tagged types : that means that you create an instance with a definite discriminant (and thus a definite size!) and cannot modify it later (just replace the object with a new one).

Another feature may be worth mentioning : Indefinite_Vectors may have a performance penalty over their Definite cousins : if so, that is the necessary cost incurred by heterogeneous object sizes and will pop up in some form however you slice the problem.

It would also be possible to eliminate the discriminant Type_T by creating different subclasses for each type of Item; maybe a cleaner design but at this stage that is more refactoring than you probably want!

Answer 3

I cleaned things up a bit, the following compiles (if you replace green-tasks w/ null; I don't have the Green_Tasks package), but I didn't test it.

with
Interfaces,
Green_Tasks,
Ada.Containers.Indefinite_Vectors,
Ada.Strings.Wide_Unbounded;

use
Green_Tasks,
Ada.Strings.Wide_Unbounded;

package Boxed_Types is

    type Type_T is (T_Null, T_UInt64, T_Text, T_Bool, T_GTask, T_Vector);
    type Item (IType : Type_T := T_Null) is private; -- Forward declaration;    


private

    type NNA_Item is Not Null Access Item;

    package Item_Vectors is new Ada.Containers.Indefinite_Vectors
      ( Index_Type   => Natural,
        Element_Type => NNA_Item
      );    

    type Item (IType : Type_T := T_Null) is record
        case IType is
        when T_Null   => null;
        when T_UInt64 => UInt64      : Interfaces.Unsigned_64;
        when T_Text   => String      : Unbounded_Wide_String;
        when T_Bool   => Bool        : Boolean;
        when T_GTask  => Green_Task  : Green_Task_Ptr;
        when T_Vector => Item_Vector : Item_Vectors.Vector;
        end case;
    end record;

end Boxed_Types;