Dynamic Instantiation in Ada95 ?

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.Oltmanns@so.sema.de, Phone: +49 4421
802 207, Fax: +49 4421 802 444,
SEMA GROUP GmbH Wilhelmshaven (Germany) - Special Systems Division -

Re: Dynamic Instantiation in Ada95 ?

[Tucker Taft]

Matthias Oltmanns (Matthias.Oltmanns@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.Oltmanns@so.sema.de, Phone: +49 4421
: 802 207, Fax: +49 4421 802 444,
: SEMA GROUP GmbH Wilhelmshaven (Germany) - Special Systems Division -

--
-Tucker Taft   stt@inmet.com   http://www.inmet.com/~stt/
Intermetrics, Inc.  Burlington, MA  USA

Re: Dynamic Instantiation in Ada95 ?

[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.
> 
> I'am interresting for a more portable approach. Any suggestions?

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;

Re: Dynamic Instantiation in Ada95 ?

[Matthew Heaney]

In article <353625E8.3809@gsfc.nasa.gov>, Stephen.Leake@gsfc.nasa.gov wrote:

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

Re: Dynamic Instantiation in Ada95 ?

[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.