From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD,
	FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4
X-Google-Thread: a07f3367d7,18684ed750c9b60f,start
X-Google-Attributes: gida07f3367d7,public,usenet
X-Google-NewGroupId: yes
X-Google-Language: ENGLISH,ASCII-7-bit
Received: by 10.224.78.209 with SMTP id m17mr8352965qak.3.1349475781085;
        Fri, 05 Oct 2012 15:23:01 -0700 (PDT)
Received: by 10.236.74.161 with SMTP id x21mr1273451yhd.13.1349475781053; Fri,
 05 Oct 2012 15:23:01 -0700 (PDT)
Path: 
 e10ni211270746qan.0!nntp.google.com!l8no27232012qao.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail
Newsgroups: comp.lang.ada
Date: Fri, 5 Oct 2012 15:23:00 -0700 (PDT)
Complaints-To: groups-abuse@google.com
Injection-Info: glegroupsg2000goo.googlegroups.com;
 posting-host=157.127.124.15;
 posting-account=Trm_OQoAAABCO0PHK-TqWioYjr8e-azv
NNTP-Posting-Host: 157.127.124.15
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <51f8461d-d362-4e5f-a188-ac96a699a211@googlegroups.com>
Subject: How to get generic formal parameter type into base class
From: kevin.miscellaneous@gmail.com
Injection-Date: Fri, 05 Oct 2012 22:23:01 +0000
Content-Type: text/plain; charset=ISO-8859-1
Date: 2012-10-05T15:23:00-07:00
List-Id: <comp.lang.ada>

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;