Re: How to get generic formal parameter type into base class

[kevin andrew <kevin.miscellaneous@gmail.com>]

On Oct 5, 8:28 pm, Adam Beneschan <a...@irvine.com> wrote:
> On Friday, October 5, 2012 3:23:01 PM UTC-7, (unknown) wrote:
> > Is there a way to get a generic formal parameter type into base class so that I can dispatch to a function with that type in the function signature? Below is what I am trying to achieve, and of course the main procedure will not compile.
>
> > Thanks,
>
> > package Classes is
>
> >    type Value_Type is range -2 ** 31 .. 2 ** 31 - 1;
>
> >    generic
> >       type Data_Type is (<>);
> >    package Translate_Base is
>
> >       type Xlate_Base_Type is abstract tagged record
> >          Value : Data_Type := Data_Type'first;
> >       end record;
>
> >       procedure Decode   (Xlate_Class : in out Xlate_Base_Type;
> >                           Value : in Value_Type) is abstract;
> >       function  Encode   (Xlate_Class : in     Xlate_Base_Type)
> >                           return Value_Type is abstract;
> >       function  Get_Value(Xlate_Class : in     Xlate_Base_Type)
> >                           return Data_Type is abstract;
> >       procedure Set_Value(Xlate_Class : in out Xlate_Base_Type;
> >                           Value : in Data_Type) is abstract;
>
> >    end Translate_Base;
>
> >    generic
> >       type Data_Type is (<>);
> >    package Translate_Integer is
>
> >       package base is new Translate_Base(Data_Type);
> >       type Xlate_Type is new base.Xlate_Base_Type with record
> >          Signed     : Boolean   := False;
> >       end record;
>
> >       procedure Decode   (Xlate_Class : in out Xlate_Type;
> >                           Value : in Value_Type);
> >       function  Encode   (Xlate_Class : in     Xlate_Type) return Value_Type;
> >       function  Get_Value(Xlate_Class : in     Xlate_Type) return Data_Type;
> >       procedure Set_Value(Xlate_Class : in out Xlate_Type;
> >                           Value : in Data_Type);
>
> >    end Translate_Integer;
>
> >    -- define Translate_Enumuration
> >    -- define Translate_Float
> >    -- ...
>
> > end Classes;
>
> > package body Classes is
>
> >    package body Translate_Integer is
>
> >       procedure Decode   (Xlate_Class : in out Xlate_Type;
> >                           Value : in Value_Type) is
> >       begin
> >          Xlate_Class.Value := Data_Type'val(Value);
> >       end Decode;
>
> >       function  Encode   (Xlate_Class : in     Xlate_Type) return Value_Type is
> >       begin
> >          return Data_Type'pos(Xlate_Class.Value);
> >       end Encode;
>
> >       function  Get_Value(Xlate_Class : in     Xlate_Type) return Data_Type is
> >       begin
> >          return Xlate_Class.Value;
> >       end Get_Value;
>
> >       procedure Set_Value(Xlate_Class : in out Xlate_Type;
> >                           Value : in Data_Type) is
> >       begin
> >           Xlate_Class.Value := Value;
> >       end Set_Value;
> >    end Translate_Integer;
>
> > end Classes;
>
> > with Classes;
>
> > package Objects is
>
> >    type Int_100_Type is range -100 .. 100;
>
> >    package Int_100 is new Classes.Translate_Integer(Int_100_Type);
>
> > end Objects;
>
> > with Classes;
> > with Objects;
> > with Ada.Text_IO;
>
> > procedure main is
> >    procedure PrintLn(Item : String) renames Ada.Text_IO.Put_Line;
>
> >    type Message_ID_Type is (type1);
>
> >    function Factory_Get (Message_ID : in Message_ID_Type)
> >                          return Classes.Xlate_Base_Type'class is
> >    begin
>
> >       case Message_ID is
> >       when type1 =>
> >          declare
> >             This : Objects.Int_100.Xlate_Type;
> >          begin
> >             return This;
> >          end;
> >       end case;
>
> >    end Factory_Get;
>
> >    This : Classes.Xlate_Base_Type'class := Factory_Get(type1);
> >    Value : Classes.Value_Type;
> >    My_Value : Objects.Int_100_Type;
> > begin
>
> >    Value := 255;  -- get FF from input stream.
> >    Classes.Translate_Base.Decode(This, Value);
> >    My_Value := Classes.Translate_Base.Get_Value(This);
>
> >    -- do something
>
> >    Classes.Translate_Base.Set_Value(This, My_Value);
> >    Value := Classes.Translate_Base.Encode(This);
> > end main;
>
> Since you're trying to use Xlate_Type'Class, it looks like you're thinking that the types involved are all related.  They're not.  A generic package isn't useful until you instantiate it, and instantiating the package has pretty much the same effect as writing it all over again, substituting something different for the formal parameters.  It's something like a macro substitution.  And if you had two types with the same name in different packages, e.g.
>
>    package Instantiation_1 is
>       type Xlate_Type is tagged record ...
>    end Instantiation_1;
>
>    package Instantiation_2 is
>       type Xlate_Type is tagged record ...
>    end Instantiation_2;
>
> you wouldn't expect the two Xlate_Type types to be related at all, and you wouldn't expect a 'Class type to be able to represent both.  Well, that's pretty much what you're getting when you define the type in the instantiation.
>
> What I think you want to do is declare an abstract root type *outside* any generic, and declare abstract procedures/functions Decode, Encode, etc., in the same package outside the generic.  Then, in Translate_Base (which could still be generic), make your Xlate_Type a type extension of that root type.  Now you can declare something as Your_Root_Type'Class and this object could represent any type derived from Your_Root_Type, including those in generic instantiations, and it could dispatch to those procedures and functions.
>
> Hope this helps,
>
>                                -- Adam- Hide quoted text -
>
> - Show quoted text -


Thanks for the responses.

I still don't see how to get a dynamic type into base class so that I
can dispatch to a function with that type in the function signature.
If I do a Root_Type then I don't see how I can include the Get/
Set_Value function because Data_Type is unknown? Any help getting my
ignorant mine understanding Ada will be greatly appreciated.  I have
included a better Main procedure which more accurately shows what I am
trying to do.

Thanks,
Kevin.

with Classes;

package Objects is

   type Mod_12_Type is mod 2 ** 12;
   type Int_100_Type is range -100 .. 100;
   type Enum_One_Type is (Minus_0ne, Zero, One);

   type External_Type is record
      theMode : Mod_12_Type;
      theInt  : Int_100_Type;
      theEnum : Enum_One_Type;
   end record;

   package Mod_12   is new Classes.Translate_Integer(Mod_12_Type);
   package Int_100  is new Classes.Translate_Integer(Int_100_Type);
   package Enum_One is new Classes.Translate_Integer(Enum_One_Type);

end Objects;



with Classes;
with Objects;
with Ada.Text_IO;


procedure main is

   procedure PrintLn(Item : String) renames Ada.Text_IO.Put_Line;

   type Message_ID_Type is (Int_100, Mod_12, Enum_One);

   function Factory_Get (Message_ID : in Message_ID_Type) return
Classes.Xlate_Base_Type'class is
   begin

      case Message_ID is

      when Int_100 =>
         declare
            This : Objects.Int_100.Xlate_Type;
         begin
            return This;
         end;

      when Mod_12 =>
         declare
            This : Objects.Mod_12.Xlate_Type;
         begin
            return This;
         end;

      when Enum_One =>
         declare
            This : Objects.Enum_One.Xlate_Type;
         begin
            return This;
         end;
      end case;

   end Factory_Get;


   Procedure Get_Values(Message_ID : in Message_ID_Type;
                        Class      : in Classes.Xlate_Base_Type'class;
                        Msg        : in out Objects.External_Type) is
   begin
      case Message_ID is

      when Int_100 =>
         Msg.theInt := Classes.Translate_Base.Get_Value(Class); --
Dispatch to Get_Value

      when Mod_12 =>
         Msg.theMode := Classes.Translate_Base.Get_Value(Class); --
Dispatch to Get_Value

      when Enum_One =>
         Msg.theEnum := Classes.Translate_Base.Get_Value(Class); --
Dispatch to Get_Value

      end case;
   end Get_Values;

   procedure Decode(Message_ID : in Message_ID_Type;
                    Value : in Classes.Value_Type;
                    Msg        : in out Objects.External_Type) is
      This : Classes.Xlate_Base_Type'class := Factory_Get(Message_ID);
   begin
      Classes.Translate_Base.Decode(This, Value);  -- Dispatch to
Decode
      Get_Values(Message_ID, This, Msg);
   end Decode;

   Value : Classes.Value_Type;
   Message  : Objects.External_Type;
begin

   Value := 255;  -- get FF from input stream.
   Decode(Int_100, Value, Message);

   Value := 240;  -- get F0 from input stream.
   Decode(Mod_12, Value, Message);

   Value := 0;  -- get 00 from input stream.
   Decode(Enum_One, Value, Message);

   -- print Message.

end main;