Dynamic Instantiation in Ada95 ?
Matthias Oltmanns
Hi all,
I would like to implement a kind of runtime instantiation for class-wide
types, where the concrete type is not known
at compile time.
I've searched for a method in exact that way as S'Class'Input is working.
S'Class'Input first reads the external tag name from a stream and than
makes a dispatching call to the appropriate S'Input method.
Example:
...
type Base is tagged with null record;
function Create return Base;
--
function Create_Dynamic (Tag_Name : String) return Base'Class;
...
<< Some type-extensions for the type Base >>
...
I would like to implement the function as follows:
function Create_Dynamic (Tag_Name : String) return Base'Class is
T : Ada.Tags.Tag := Ada.Tags.Internal_Tag (Tag_Name);
begin
return <<dispatching call to Create using tag T>>;
end Create_Dynamic;
Is there a way to do that? I've found only some dirty hacks, using
unchecked_deallocation , for T'Address use ...
and so on.
I'am interresting for a more portable approach. Any suggestions?
Matthias Oltmanns, Email: Matthias...@so.sema.de, Phone: +49 4421
802 207, Fax: +49 4421 802 444,
SEMA GROUP GmbH Wilhelmshaven (Germany) - Special Systems Division -
Tucker Taft
Matthias Oltmanns (Matthias...@SO.SEMA.DE) wrote:
: I would like to implement a kind of runtime instantiation for class-wide
: types, where the concrete type is not known
: at compile time.
: I've searched for a method in exact that way as S'Class'Input is working.
: S'Class'Input first reads the external tag name from a stream and than
: makes a dispatching call to the appropriate S'Input method.
: Example:
: ...
: type Base is tagged with null record;
: function Create return Base;
: --
: function Create_Dynamic (Tag_Name : String) return Base'Class;
: ...
: << Some type-extensions for the type Base >>
: ...
: I would like to implement the function as follows:
: function Create_Dynamic (Tag_Name : String) return Base'Class is
: T : Ada.Tags.Tag := Ada.Tags.Internal_Tag (Tag_Name);
: begin
: return <<dispatching call to Create using tag T>>;
: end Create_Dynamic;
: Is there a way to do that? I've found only some dirty hacks, using
: unchecked_deallocation , for T'Address use ...
: and so on.
No, there is no easy way to use the external or internal tag value
as a way to drive dynamic object creation (the word "dynamic
instantiation" will probably make most Ada people think of
generic instantiation).
: I'am interresting for a more portable approach. Any suggestions?
I recommend you create your own registration table, where
you register object-creating functions (by storing an
access-to-subprogram value designating them), one for each
distinct type you want to be able to create. The registration
table would be indexed by some kind of ID (conceivably the
external tag, though any unique ID would do). You use this
ID to index into the registration table and get a pointer to the
object-creating function, and then you call that and return
the result.
: Matthias Oltmanns, Email: Matthias...@so.sema.de, Phone: +49 4421
: 802 207, Fax: +49 4421 802 444,
: SEMA GROUP GmbH Wilhelmshaven (Germany) - Special Systems Division -
--
-Tucker Taft s...@inmet.com http://www.inmet.com/~stt/
Intermetrics, Inc. Burlington, MA USA
Stephen Leake
Matthias Oltmanns wrote:
>
> Hi all,
>
> I would like to implement a kind of runtime instantiation for class-wide
> types, where the concrete type is not known
> at compile time.
> I've searched for a method in exact that way as S'Class'Input is working.
> S'Class'Input first reads the external tag name from a stream and than
> makes a dispatching call to the appropriate S'Input method.
>
> Example:
> ...
> type Base is tagged with null record;
>
> function Create return Base;
> --
> function Create_Dynamic (Tag_Name : String) return Base'Class;
> ...
> << Some type-extensions for the type Base >>
> ...
>
> I would like to implement the function as follows:
>
> function Create_Dynamic (Tag_Name : String) return Base'Class is
> T : Ada.Tags.Tag := Ada.Tags.Internal_Tag (Tag_Name);
> begin
> return <<dispatching call to Create using tag T>>;
> end Create_Dynamic;
>
> Is there a way to do that? I've found only some dirty hacks, using
> unchecked_deallocation , for T'Address use ...
> and so on.
>
You can read from a string using 'Input; you just have to define String
Streams. Here's some code that defines Memory Streams; you'll have to
replace Address with String'access or something like that. Let me know
if you get it to work!
--
- Stephe
with System.Address_To_Access_Conversions;
with Ada.Streams; use Ada.Streams;
package SAL.Memory_Streams is
pragma Preelaborate;
-- we can't use IO_Exceptions, because that package doesn't have
Preelaborate.
Status_Error : exception;
End_Error : exception;
private
package Stream_Element_Address_Conversions is new
System.Address_To_Access_Conversions (Stream_Element);
type Direction_Type is (In_Stream, Out_Stream);
end SAL.Memory_Streams;
-- Abstract:
-- A memory stream type, for obtaining raw byte images of types.
--
with System;
with Ada.Streams; use Ada.Streams;
package SAL.Memory_Streams.Bounded is
pragma Preelaborate;
type Stream_Type (Max_Length : Stream_Element_Count)
is new Root_Stream_Type with private;
procedure Create (Stream : in out Stream_Type);
-- create an empty Stream with direction Out_Stream, for writing.
procedure Create
(Stream : in out Stream_Type;
Data : in Stream_Element_Array);
-- create a Stream with data, with direction In_Stream, for reading.
-- raises Constraint_Error if Data overflows Stream
procedure Create
(Stream : in out Stream_Type;
Address : in System.Address);
-- create a Stream with data from Address, copying Stream.Max_Length
-- bytes, with direction In_Stream, for reading.
function Length (Stream : in Stream_Type) return
Stream_Element_Count;
-- for an In_Stream, the amount of data left to be read.
-- for an Out_Stream, the amount of data written.
function Address (Stream : in Stream_Type) return System.Address;
-- for an In_Stream, raises Status_Error.
-- for an Out_Stream, the address of the first element of the raw
-- Stream, for passing to system routines.
procedure Read
(Stream : in out Stream_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- for an In_Stream, reads elements from Stream, storing them in
-- Item. Stops when Item'Last or end of Stream is reached, setting
Last to
-- last element of Item written.
--
-- for an Out_Stream, raises Status_Error.
procedure Write
(Stream : in out Stream_Type;
Item : in Stream_Element_Array);
-- for an In_Stream, raises Status_Error.
--
-- for an Out_Stream, writes elements from Item to the Stream,
stopping
-- when Item'last is reached. Raises End_Error if attempt
-- to write past end of Stream.
private
type Stream_Type (Max_Length : Stream_Element_Count)
is new Ada.Streams.Root_Stream_Type with
record
-- Direction is not a discriminant, because we anticipate changing
-- direction on some streams.
Direction : Direction_Type;
Last : Stream_Element_Offset := 0;
-- last element of Raw that has been read/written
Raw : Stream_Element_Array (1 .. Max_Length);
end record;
end SAL.Memory_Streams.Bounded;
-- Abstract:
-- see spec
--
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
package body SAL.Memory_Streams.Bounded is
procedure Create (Stream : in out Stream_Type)
is begin
Stream.Last := 0;
Stream.Direction := Out_Stream;
end Create;
procedure Create
(Stream : in out Stream_Type;
Data : in Stream_Element_Array)
is begin
Stream.Raw (1 .. Data'Length) := Data;
Stream.Last := 0;
Stream.Direction := In_Stream;
end Create;
package Stream_Element_Address_Conversions is new
System.Address_To_Access_Conversions (Stream_Element);
procedure Create
(Stream : in out Stream_Type;
Address : in System.Address)
is
function "+" (Left : System.Address; Right :
System.Storage_Elements.Storage_Offset)
return System.Address renames
System.Storage_Elements."+";
Temp : System.Address := Address;
begin
for I in Stream.Raw'Range loop
Stream.Raw (I) := Stream_Element_Address_Conversions.To_Pointer
(Address).all;
Temp := Temp + 1;
end loop;
Stream.Direction := In_Stream;
Stream.Last := 0;
end Create;
function Length (Stream : in Stream_Type) return Stream_Element_Count
is begin
case Stream.Direction is
when In_Stream =>
return Stream.Raw'Last - Stream.Last;
when Out_Stream =>
return Stream.Last;
end case;
end Length;
function Address (Stream : in Stream_Type) return System.Address
is begin
case Stream.Direction is
when In_Stream =>
raise Status_Error;
when Out_Stream =>
return Stream.Raw (1)'Address;
end case;
end Address;
procedure Read
(Stream : in out Stream_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is begin
case Stream.Direction is
when In_Stream =>
declare
Remaining : constant Stream_Element_Offset :=
Stream.Raw'Last - Stream.Last;
begin
if Remaining >= Item'Length then
Item := Stream.Raw (Stream.Last + 1 .. Stream.Last +
Item'Length);
Stream.Last := Stream.Last + Item'Length;
Last := Item'Last;
else
Last := Item'First + Remaining - 1;
Item (Item'First .. Last) := Stream.Raw (Stream.Last + 1
.. Stream.Raw'Last);
Stream.Last := Stream.Raw'Last;
end if;
end;
when Out_Stream =>
raise Status_Error;
end case;
end Read;
procedure Write
(Stream : in out Stream_Type;
Item : in Stream_Element_Array)
is begin
case Stream.Direction is
when In_Stream =>
raise Status_Error;
when Out_Stream =>
declare
Remaining : constant Stream_Element_Offset :=
Stream.Raw'Last - Stream.Last;
begin
if Remaining >= Item'Length then
Stream.Raw (Stream.Last + 1 .. Stream.Last + Item'Length)
:= Item;
Stream.Last := Stream.Last + Item'Length;
else
raise End_Error;
end if;
end;
end case;
end Write;
end SAL.Memory_Streams.Bounded;
-- and some code to test the above
package SAL.Memory_Streams.Bounded.Test is
pragma Elaborate_Body;
end SAL.Memory_Streams.Bounded.Test;
with Ada.Text_IO; use Ada.Text_IO;
package body SAL.Memory_Streams.Bounded.Test
is
type Point_Type is record
X : Integer;
Y : Integer;
end record;
Point : Point_Type := (0, 0);
Memory_Buffer : aliased Stream_Type (10);
procedure Put (Item : in Point_Type)
is begin
Put ("(" & Integer'Image (Item.X) & ", ");
Put (Integer'Image (Item.Y) & ")");
end Put;
procedure Put (Item : in Stream_Element_Array)
is begin
Put ("(");
for I in Item'First .. Item'Last - 1 loop
Put (Stream_Element'Image (Item (I)) & ", ");
end loop;
Put (Stream_Element'Image (Item (Item'last)) & ")");
end Put;
begin
Put_Line ("testing SAL.Memory_Streams.Bounded");
Put_Line ("write => (1, 2)");
Create (Memory_Buffer);
Point_Type'Write (Memory_Buffer'access, Point_Type'(1, 2));
Put ("Got => "); Put (Memory_Buffer.Raw (1 .. Memory_Buffer.Last));
New_Line (2);
Put_Line ("read => ");
Create (Memory_Buffer, Memory_Buffer.Raw (1 .. Memory_Buffer.Last));
Point_Type'Read (Memory_Buffer'Access, Point);
Put (Point);
New_Line (2);
Put_Line ("done");
end SAL.Memory_Streams.Bounded.Test;
with SAL.Memory_Streams.Bounded.Test;
procedure Test_Memory_Streams_Bounded
is begin
null;
end Test_Memory_Streams_Bounded;
Matthew Heaney
>with System.Address_To_Access_Conversions;
>with Ada.Streams; use Ada.Streams;
>package SAL.Memory_Streams is
> pragma Preelaborate;
>
> -- we can't use IO_Exceptions, because that package doesn't have
>Preelaborate.
It doesn't have Preelaborate, because it's Pure. So you can legally with
package Ada.IO_Exceptions.
> Status_Error : exception;
> End_Error : exception;
Robert Dewar
<<I've searched for a method in exact that way as S'Class'Input is working.
S'Class'Input first reads the external tag name from a stream and than
makes a dispatching call to the appropriate S'Input method.
>>
Interesting point! Have a look at the GNAT sources here to understand
the situation. You will see that there is indeed some implementation
dependent magic here. You cannot implement S'Class'Input staying strictly
within the language.