comp.lang.ada
 help / color / mirror / Atom feed
From: kevin.miscellaneous@gmail.com
Subject: How to get generic formal parameter type into base class
Date: Fri, 5 Oct 2012 15:23:00 -0700 (PDT)
Date: 2012-10-05T15:23:00-07:00	[thread overview]
Message-ID: <51f8461d-d362-4e5f-a188-ac96a699a211@googlegroups.com> (raw)

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;
 



             reply	other threads:[~2012-10-05 22:23 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2012-10-05 22:23 kevin.miscellaneous [this message]
2012-10-05 23:38 ` How to get generic formal parameter type into base class Georg Bauhaus
2012-10-06  3:28 ` Adam Beneschan
2012-10-06 20:03   ` kevin andrew
2012-10-07  3:06     ` Adam Beneschan
2012-10-11 20:25       ` kevin andrew
2012-10-11 23:28         ` Georg Bauhaus
2012-10-11 23:52         ` Georg Bauhaus
2012-10-07  7:42     ` Dmitry A. Kazakov
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox