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;
next 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