Re: access to controlled types

[Matthew Heaney <matthew_heaney@acm.org>]

"Terry J. Westley" <twestley@buffalo.veridian.com> writes:

> You have a good point.  I'll think about it a bit.  The specific
> situation is that TASH supports Tcl lists which are heterogenous.
> 
> So, when you fetch an element out of the list, it could be an
> integer, a float, a string, or another list.


Can your list return a discriminated object? Something like the code
below.

I don't think you need to return a tagged type object here, because your
interest is in an object (the item in the list), not in operations of a
type.

The items in your list are heterogenous, but they are all not part of
the same type hierarchy: floats and integers and strings and lists are
all different classes of types.  That means you need a variant record,
not a tagged type.

To use this list, you'd do like this:

declare
  Item : constant List_Item := Get_Head (List);
begin
  case Get_Item_Kind (Item) is
    when Float_List_Item =>
        declare
          F : constant Float := Get_Float_Item (Item);
        begin
          <do something with F>
        end;

    when Integer_List_Item => 
        ...

end;



with Ada.Finalization;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Lists is

   type List_Type is private;

   type List_Item (<>) is private;

   function Get_Head
     (List : List_Type) return List_Item;

   -- other list ops here

   type List_Item_Kind is
      (Float_List_Item,
       Integer_List_Item,
       String_List_Item,
       List_List_Item);

   function Get_Item_Kind
     (Item : List_Item) return List_Item_Kind;

   function Get_Float_Item
     (Item : List_Item) return Float;

   -- gets for other kinds here

private

   type Node_Type;
   type Node_Access is access Node_Type;

   type List_Type is
     new Ada.Finalization.Controlled with record
        Head : Node_Access;
     end record;

   procedure Adjust (List : in out List_Type);

   procedure Finalize (List : in out List_Type);


   type List_Item
     (Kind : List_Item_Kind := List_Item_Kind'First) is
      record
         case Kind is
            when Float_List_Item =>
               F : Float;

            when Integer_List_Item =>
               I : Integer;

            when String_List_Item =>
               S : Unbounded_String;

            when List_List_Item =>
               L : List_Type;

         end case;
      end record;

end Lists;



package body Lists is

   type Node_Type is
      record
         Item      : List_Item;
         Ref_Count : Natural := 0;
         Next      : List_Type; -- or Node_Access?
      end record;


   function Get_Head
     (List : List_Type) return List_Item is
   begin
      return List.Head.Item;
   end;


   function Get_Item_Kind
     (Item : List_Item) return List_Item_Kind is
   begin
      return Item.Kind;
   end;

   function Get_Float_Item
     (Item : List_Item) return Float is
   begin
      return Item.F;
   end;


   procedure Adjust (List : in out List_Type) is
   begin
      null; -- adjust ref count
   end;


   procedure Finalize (List : in out List_Type) is
   begin
      null; -- adjust ref count
   end;


end Lists;