BRYAN@SU-SIERRA.ARPA (Doug Bryan) (09/20/85)
As usual, Dr. Helfinger has brought up some very good points.
When Ada cannot do what you want it to do, explain the problem
better (implement a package - extensability).
The following package and demo main-line demonstrates his ideas.
To "fully" implement this capability, the package should also contain
the full capabilities of Text_Io so that default aft, exp, file_type...
may be used.
The output version here is fairly trivial. Anybody have any ideas
on the input version keeping 4.3(7) in mind??????
doug
----------------------------------------------------------
with Text_Io;
generic
type Int is range <>;
type Enum is (<>);
type Fl is digits <>;
type Fx is delta <>;
package Poly_Images is
function "&" (Left : String; Right : Int) return String;
function "&" (Left : Int; Right : String) return String;
function Fmt (I : Int;
Width : Text_Io.Field;
Base : Text_Io.Number_Base) return String;
function "&" (Left : String; Right : Enum) return String;
function "&" (Left : Enum; Right : String) return String;
function Fmt (E : Enum;
Width : Text_Io.Field;
Set : Text_Io.Type_Set) return String;
function "&" (Left : String; Right : Fl) return String;
function "&" (Left : Fl; Right : String) return String;
function Fmt (F : Fl;
Width, Aft, Exp : Text_Io.Field) return String;
function "&" (Left : String; Right : Fx) return String;
function "&" (Left : Fx; Right : String) return String;
function Fmt (F : Fx;
Width, Aft, Exp : Text_Io.Field) return String;
end Poly_Images;
----------------------------------------------------------
with Text_Io;
package body Poly_Images is
package Int_Io is new Text_Io.Integer_Io (Int);
package Enum_Io is new Text_Io.Enumeration_Io (Enum);
package Fl_Io is new Text_Io.Float_Io (Fl);
package Fx_Io is new Text_Io.Fixed_Io (Fx);
function "&" (Left : String; Right : Int) return String is
begin
return Left & Int'Image (Right);
end "&";
function "&" (Left : Int; Right : String) return String is
begin
return Int'Image (Left) & Right;
end "&";
function "&" (Left : String; Right : Enum) return String is
begin
return Left & Enum'Image (Right);
end "&";
function "&" (Left : Enum; Right : String) return String is
begin
return Enum'Image (Left) & Right;
end "&";
function Strip_Leading_Blanks (Within : String) return String is
begin
for I in Within'Range loop
if Within (I) /= ' ' then
if Within (I) = '-' or
Within (I) = '+' or
Within (I) not in '0' .. '9' then
return Within (I .. Within'Last);
else
return Within (I - 1 .. Within'Last);
end if;
end if;
end loop;
return "";
exception
when Constraint_Error =>
return Within;
end Strip_Leading_Blanks;
function "&" (Left : String; Right : Fl) return String is
Image : String (1 .. 300);
begin
Fl_Io.Put (To => Image, Item => Right);
return Left & Strip_Leading_Blanks (Image);
end "&";
function "&" (Left : Fl; Right : String) return String is
Image : String (1 .. 300);
begin
Fl_Io.Put (To => Image, Item => Left);
return Strip_Leading_Blanks (Image) & Right;
end "&";
function "&" (Left : String; Right : Fx) return String is
Image : String (1 .. 300);
begin
Fx_Io.Put (To => Image, Item => Right);
return Left & Strip_Leading_Blanks (Image);
end "&";
function "&" (Left : Fx; Right : String) return String is
Image : String (1 .. 300);
begin
Fx_Io.Put (To => Image, Item => Left);
return Strip_Leading_Blanks (Image) & Right;
end "&";
function Fmt (I : Int;
Width : Text_Io.Field;
Base : Text_Io.Number_Base) return String is
Image : String (1 .. 300);
begin
if Width = 0 then
Int_Io.Put (Image, I, Base);
return Strip_Leading_Blanks (Image);
else
Int_Io.Put (Image (1 .. Width), I, Base);
return Image (1 .. Width);
end if;
end Fmt;
function Fmt (E : Enum;
Width : Text_Io.Field;
Set : Text_Io.Type_Set) return String is
Image : String (1 .. 300);
begin
if Width = 0 then
Enum_Io.Put (Image, E, Set);
return Strip_Leading_Blanks (Image);
else
Enum_Io.Put (Image (1 .. Width), E, Set);
return Image (1 .. Width);
end if;
end Fmt;
function Fmt (F : Fl;
Width, Aft, Exp : Text_Io.Field) return String is
Image : String (1 .. 300);
begin
if Width = 0 then
Fl_Io.Put (Image, F, Aft, Exp);
return Strip_Leading_Blanks (Image);
else
Fl_Io.Put (Image (1 .. Width), F, Aft, Exp);
return Image (1 .. Width);
end if;
end Fmt;
function Fmt (F : Fx;
Width, Aft, Exp : Text_Io.Field) return String is
Image : String (1 .. 300);
begin
if Width = 0 then
Fx_Io.Put (Image, F, Aft, Exp);
return Strip_Leading_Blanks (Image);
else
Fx_Io.Put (Image (1 .. Width), F, Aft, Exp);
return Image (1 .. Width);
end if;
end Fmt;
end Poly_Images;
----------------------------------------------------------
with Text_Io,
Poly_Images;
use Text_Io;
procedure Poly_Images_Test is
package Images is new Poly_Images
(Int => Integer,
Enum => Boolean,
Fl => Float,
Fx => Duration);
use Images;
I : Integer;
Fp : Float;
Fd : Duration;
E : Boolean;
begin
I := 12; Fp := 12.12; Fd := 1.0102; E := True;
Put_Line ("integer = " & I & ", floating = " & Fp &
", fixed = " & Fd & ", enumation = " & E);
I := -12; Fp := -12.12; Fd := -1.0102; E := False;
Put_Line ("integer = " & I & ", floating = " & Fp &
", fixed = " & Fd & ", enumeration = " & E);
Put_Line ("integer = " & Fmt (I, 10, 8) & ", floating = " &
Fmt (Fp, 10, 2, 0) & "," );
Put_Line (" fixed = " &
Fmt (Fd, 10, 4, 0) & ", enumeration = " &
Fmt (E, 10, Lower_Case));
exception
when others =>
New_Line;
Put_Line ("Fatal exception propagation.");
end Poly_Images_Test;
pragma Main;
-------