|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 8389 (0x20c5)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Text_Io;
with Names_And_Expressions;
with Declarations;
with Ada_Program;
with Type_Information;
with String_Utilities;
package body Type_Images is
package Ap renames Ada_Program;
package Ti renames Type_Information;
package Su renames String_Utilities;
package Exp renames Names_And_Expressions;
function "=" (A, B : Ti.Type_Definition_Kinds) return Boolean
renames Ti."=";
package Float_Io is new Text_Io.Float_Io (Float);
---- UTILITIES ----
function Float_Image (Number : Float) return String is
Holder : String (1 .. 12);
begin
Float_Io.Put (Holder, Number, 4, 3);
return Su.Strip (Holder);
end Float_Image;
function Size_Of (Lower, Upper : Integer) return Natural is
type T is new Integer range Lower .. Upper;
begin
return T'Size;
end Size_Of;
procedure Enumeration_Range (Enum_Type_Def : Ada_Program.Element;
Lbound, Ubound : in out Integer) is
Enum_Elements : Ada_Program.Element_Iterator;
begin
Enum_Elements := Ti.Enumeration_Literals (Enum_Type_Def);
Lbound := 0;
Ubound := Lbound - 1;
while not Ada_Program.Done (Enum_Elements) loop
Ubound := Ubound + 1;
Ada_Program.Next (Enum_Elements);
end loop;
end Enumeration_Range;
procedure Integer_Range_Constraint_Bounds
(Constraint : Ti.Type_Constraint;
Lbound, Ubound : in out Long_Integer;
Static : out Boolean) is
Lower, Upper : Ti.Expression;
begin
case Ti.Constraint_Kind (Constraint) is
when Ti.A_Simple_Range =>
Ti.Bounds (Constraint, Lower, Upper);
if Exp.Is_Static (Lower) and then Exp.Is_Static (Upper) then
Lbound := Exp.Static_Value (Lower);
Ubound := Exp.Static_Value (Upper);
Static := True;
return;
end if;
when Ti.A_Range_Attribute =>
null;
when others =>
raise Program_Error;
end case;
Lbound := 0;
Ubound := 0;
Static := False;
end Integer_Range_Constraint_Bounds;
procedure Float_Range_Constraint_Bounds (Constraint : Ti.Type_Constraint;
Lbound, Ubound : in out Float;
Static : out Boolean) is
Lower, Upper : Ti.Expression;
begin
case Ti.Constraint_Kind (Constraint) is
when Ti.A_Simple_Range =>
Ti.Bounds (Constraint, Lower, Upper);
if Exp.Is_Static (Lower) and then Exp.Is_Static (Upper) then
Lbound := Exp.Static_Value (Lower);
Ubound := Exp.Static_Value (Upper);
Static := True;
return;
end if;
when Ti.A_Range_Attribute =>
null;
when others =>
raise Program_Error;
end case;
Lbound := 0.0;
Ubound := 0.0;
Static := False;
end Float_Range_Constraint_Bounds;
function Range_Constraint_Image
(Constraint : Ti.Type_Constraint) return String is
Lower, Upper : Ti.Expression;
Lbound, Ubound : Long_Integer;
Static : Boolean;
begin
case Ti.Constraint_Kind (Constraint) is
when Ti.A_Simple_Range =>
Integer_Range_Constraint_Bounds
(Constraint, Lbound, Ubound, Static);
if Static then
return Long_Integer'Image (Lbound) & " .. " &
Long_Integer'Image (Ubound);
else
Ti.Bounds (Constraint, Lower, Upper);
return Ada_Program.Image (Lower) & " .. " &
Ada_Program.Image (Upper);
end if;
when Ti.A_Range_Attribute =>
return Ada_Program.Image (Constraint);
when others =>
return "UNIMPLEMENTED";
end case;
end Range_Constraint_Image;
function Float_Range_Constraint_Image
(Constraint : Ti.Type_Constraint) return String is
Lower, Upper : Ti.Expression;
Lbound, Ubound : Float;
Static : Boolean;
begin
case Ti.Constraint_Kind (Constraint) is
when Ti.A_Simple_Range =>
Float_Range_Constraint_Bounds
(Constraint, Lbound, Ubound, Static);
if Static then
return Float_Image (Lbound) & " .. " & Float_Image (Ubound);
else
Ti.Bounds (Constraint, Lower, Upper);
return Ada_Program.Image (Lower) & " .. " &
Ada_Program.Image (Upper);
end if;
when Ti.A_Range_Attribute =>
return Ada_Program.Image (Constraint);
when others =>
return "UNIMPLEMENTED";
end case;
end Float_Range_Constraint_Image;
function Constraint (For_Type : Type_Information.Type_Definition)
return Ap.Element is
Element : Ada_Program.Element := For_Type;
Constraint : Ada_Program.Element;
Lbound, Ubound : Integer;
begin
loop
case Ti.Kind (Element) is
when Ti.A_Subtype_Indication =>
Constraint := Ti.Constraint (Element);
if Ada_Program.Is_Nil (Constraint) then
Element := Ti.Type_Mark (Element);
else
return Constraint;
end if;
when Ti.An_Integer_Type_Definition =>
return Ti.Integer_Constraint (Element);
when Ti.A_Float_Type_Definition =>
return Ti.Floating_Point_Constraint (Element);
when Ti.A_Derived_Type_Definition =>
Element := Ti.Ground_Type (Element);
when others =>
return Element;
end case;
end loop;
end Constraint;
function Lbound (For_Integer_Type : Type_Information.Type_Definition)
return Long_Integer is
U, L : Long_Integer;
B : Boolean;
begin
Integer_Range_Constraint_Bounds
(Constraint (For_Integer_Type), L, U, B);
return L;
end Lbound;
function Ubound (For_Integer_Type : Type_Information.Type_Definition)
return Long_Integer is
U, L : Long_Integer;
B : Boolean;
begin
Integer_Range_Constraint_Bounds
(Constraint (For_Integer_Type), L, U, B);
return U;
end Ubound;
function Lbound (For_Float_Type : Type_Information.Type_Definition)
return Float is
U, L : Float;
B : Boolean;
begin
Float_Range_Constraint_Bounds (Constraint (For_Float_Type), L, U, B);
return L;
end Lbound;
function Ubound (For_Float_Type : Type_Information.Type_Definition)
return Float is
U, L : Float;
B : Boolean;
begin
Float_Range_Constraint_Bounds (Constraint (For_Float_Type), L, U, B);
return U;
end Ubound;
function Lbound (For_Enum_Type : Type_Information.Type_Definition)
return String is
Enum_Elements : Ada_Program.Element_Iterator;
Lit : Ada_Program.Element;
begin
Enum_Elements := Ti.Enumeration_Literals (For_Enum_Type);
Lit := Ada_Program.Value (Enum_Elements);
return Ada_Program.Image (Lit);
end Lbound;
function Ubound (For_Enum_Type : Type_Information.Type_Definition)
return String is
Enum_Elements : Ada_Program.Element_Iterator;
Lit : Ada_Program.Element;
begin
Enum_Elements := Ti.Enumeration_Literals (For_Enum_Type);
loop
Lit := Ada_Program.Value (Enum_Elements);
Ada_Program.Next (Enum_Elements);
if Ada_Program.Done (Enum_Elements) then
exit;
end if;
end loop;
return Ada_Program.Image (Lit);
end Ubound;
end Type_Images;