Let's get started…
Since Ada 95 it has been possible to stream any object. Using
'Read/'Write attributes, any object (tagged or not) can be streamed using a binary representation. This means that objects can be written into a file or sent over a socket, for example.
Let's take a simple object hierarchy to illustrate this feature. We'll have a Point (x and y coordinate) and a Pixel (a Point with a color).
package Object is type Point is tagged record X, Y : Float; end record; type Color_Name is (Red, Green, Blue); type Pixel is new Point with record Color : Color_Name; end record; end Object;
When writing a Point or a Pixel the first bytes in the stream are the tag external representation then the object's attribute values.
declare File : File_Type; P : Point'Class := ...; begin Create (File, Out_File, "streamed.data"); Point'Class'Output (Text_Streams.Stream (File), P); Close (File); end;
The stream will contain something like (where
<01> <00> <00> <00> <0C> <00> <00> <00> O B J E C T . P I X E L <9A> <99> <99> <3f> <66> <66> <06> <41> <00>
The tag is an important part as it will be used to be able to create the proper object instance out of the stream.
P := constant Point'Class := Point'Class'Input (Text_Streams.Stream (File));
All is well! No, there is a little missing feature. There is no way to control how the external tag is streamed. In fact, it is a string and the bounds (lower and upper) are first output into the stream. These bounds are plain numbers written in binary.
In the above example we have the four first bytes for lower bound (equal to 1) and the four following bytes for the upper bound (equal to 12) then the twelve bytes for the external tag full name OBJECT.PIXEL.
In Ada 95 there is no way to stream a textual representation of objects!
But the good news is... Ada 2005 can do this. Ada 2005 goes further by adding support to control finely the external representation of any objects. This means that it is now possible to create a textual representation of such an object using the
Let's put in place the missing pieces.
'Write attributes to output or read the XML representation of a Point or a Pixel.
with Ada.Streams; package Object is type Point is ... procedure Read (S : access Root_Stream_Type'Class; O : out Point); for Point'Read use Read; procedure Write (S : access Root_Stream_Type'Class; O : in Point); for Point'Write use Write; type Pixel is ... procedure Read (S : access Root_Stream_Type'Class; O : out Pixel); for Pixel'Read use Read; procedure Write (S : access Root_Stream_Type'Class; O : in Pixel); for Pixel'Write use Write;
Read routines could be implemented using a full featured XML parser like XML/Ada. For conciseness, we will use two very simple XML oriented routines:
procedure Skip_Tag (S : access Ada.Streams.Root_Stream_Type'Class; Ending : in Character := '>'); -- Skip the next tag on stream S, returns when Ending is found function Get_Value (S : access Ada.Streams.Root_Stream_Type'Class) return String; -- Returns the current value read on stream S
Using those routines the
'Write implementation are straightforward. Here is the implementation for a Point:
procedure Read (S : access Root_Stream_Type'Class; O : out Point) is begin Skip_Tag (S); O.X := Float'Value (Get_Value (S)); Skip_Tag (S, ASCII.LF); Skip_Tag (S); O.Y := Float'Value (Get_Value (S)); Skip_Tag (S, ASCII.LF); end Read; procedure Write (S : access Root_Stream_Type'Class; O : in Point) is begin String'Write (S, " <x>" & Float'Image (O.X) & "</x>" & ASCII.LF); String'Write (S, " <y>" & Float'Image (O.Y) & "</y>" & ASCII.LF); end Write;
The last missing piece is the handing of the tag. We want the tag to be simply: <point> and <pixel> (no bound and just the name of the object instead of the full name prefixed by the enclosing package name). To set the proper tag name we use the
package Object is type Point is ... for Point'External_Tag use "point"; type Pixel is ... for Pixel'External_Tag use "pixel";
Then we want to plug in our own XML oriented implementation of the
'Class'Output attributes. This is necessary only for the root type Point:
package Object is type Point is ... for Point'External_Tag use "point"; procedure Class_Output (S : access Ada.Streams.Root_Stream_Type'Class; O : in Point'Class); for Point'Class'Output use Class_Output; function Class_Input (S : access Ada.Streams.Root_Stream_Type'Class) return Point'Class; for Point'Class'Input use Class_Input;
Class_Output routine must output the opening XML tag, output the object itself and then the closing XML tag. Quite simple to do; the following is the commented code:
procedure Class_Output (S : access Ada.Streams.Root_Stream_Type'Class; O : in Point'Class) is begin -- Write the opening tag
Character'Write (S, '<'); String'Write (S, Ada.Tags.External_Tag (O'Tag)); String'Write (S, '>' & ASCII.LF); -- Write the object, dispatching call to Point/Pixel'Write Point'Output (S, O); -- Write the closing tagCharacter'Write (S, '<'); Character'Write (S, '/'); String'Write (S, Ada.Tags.External_Tag (O'Tag)); String'Write (S, '>' & ASCII.LF); end Class_Output;
And now the final part using
Ada.Tags.Generic_Dispatching_Constructor which will create an object out of a stream given the object's tag. This must do the exact opposite of the
Class_Output routine. The opening XML tag is read, then the object using
Generic_Dispatching_Constructor and finally the closing XML tag.
function Class_Input (S : access Ada.Streams.Root_Stream_Type'Class) return Point'Class is function Dispatching_Input is new Ada.Tags.Generic_Dispatching_Constructor (T => Point, Parameters => Ada.Streams.Root_Stream_Type'Class, Constructor => Point'Input); Input : String (1 .. 20); Input_Len : Natural := 0; begin -- On the stream we have
, we want to get "tag_name" -- Read first character, must be '<' Character'Read (S, Input (1)); if Input (1) /= '<' then raise Ada.Tags.Tag_Error with "starting with " & Input (1); end if; -- Read the tag name Input_Len := 0; for I in Input'range loop Character'Read (S, Input (I)); Input_Len := I; exit when Input (I) = '>'; end loop; -- Check ending tag if Input (Input_Len) /= '>' or else Input_Len <= 1 then -- Empty tag raise Ada.Tags.Tag_Error with "empty tag"; else Input_Len := Input_Len - 1; end if; declare External_Tag : constant String := Input (1 .. Input_Len); O : constant Point'Class := Dispatching_Input (Ada.Tags.Internal_Tag (External_Tag), S); -- Dispatches to appropriate Point/Pixel'Input depending on -- the tag name. begin -- Skip closing object tag Skip_Tag (S); Skip_Tag (S, ASCII.LF); return O; end; end Class_Input;
At this point the code shown at the start will still work without modification. The fact that the object is streamed using an XML representation is transparent to the users of the Object package.
As a final note, for conciseness, the code as-is does not output conformant XML documents as there is no XML header and there are multiple root nodes. This is left as an exercise to the reader.
Related Source Code
Ada Gems example files are distributed by AdaCore and may be used or modified for any purpose without restrictions.
- gem_19.ada - (8 KB)