|
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 - downloadIndex: ┃ B T ┃
Length: 9729 (0x2601)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦e24fb53b7⟧
└─⟦this⟧
package body Unconstrained_Array is
type Object_Structure (Kind : Types := Integer; Size : Natural := 0) is
record
case Kind is
when Integer =>
The_Integer : Standard.Integer := 0;
when Boolean =>
The_Boolean : Standard.Boolean := Standard.False;
when Collection =>
The_Collection : Objects (1 .. Size) := Null_Objects;
when Undefined =>
null;
end case;
end record;
function Value (I : Standard.Integer) return Object is
begin
return new Object_Structure'(Kind => Integer,
Size => 0,
The_Integer => I);
end Value;
function Value (B : Standard.Boolean) return Object is
begin
return new Object_Structure'(Kind => Boolean,
Size => 0,
The_Boolean => B);
end Value;
function Value (The_Objects : Objects) return Object is
begin
return new Object_Structure'(Kind => Collection,
Size => The_Objects'
Last,
The_Collection => The_Objects);
end Value;
function Get (The_Object : Object) return Standard.Integer is
begin
return The_Object.The_Integer;
end Get;
function Get (The_Object : Object) return Standard.Boolean is
begin
return The_Object.The_Boolean;
end Get;
function Get (The_Object : Object; The_Position : Natural) return Object is
begin
return The_Object.The_Collection (The_Position);
end Get;
procedure Set (The_Object : in out Object; To : Standard.Integer) is
begin
The_Object.all := (Kind => Integer, Size => 0, The_Integer => To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.Boolean) is
begin
The_Object.all := (Kind => Boolean, Size => 0, The_Boolean => To);
end Set;
procedure Set (The_Object : in out Object; To : Objects) is
begin
The_Object.all :=
(Kind => Collection, Size => To'Last, The_Collection => To);
end Set;
function Undefined_Value return Object is
begin
return Null_Object;
end Undefined_Value;
function Is_Undefined (The_Object : Object) return Standard.Boolean is
begin
return The_Object = Null_Object;
end Is_Undefined;
procedure Make_Undefined (The_Object : in out Object) is
begin
The_Object := Null_Object;
end Make_Undefined;
function Have_Same_Type (Left, Right : Object) return Standard.Boolean is
begin
return Left.Kind = Right.Kind;
end Have_Same_Type;
procedure Put (The_Objects : Objects; Where : Output_Stream.Object) is
begin
for I in The_Objects'Range loop
Put (The_Objects (I), Where);
end loop;
end Put;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
begin
case The_Object.Kind is
when Integer =>
Output_Stream.Put (The_Object.The_Integer, Where);
when Boolean =>
Output_Stream.Put (The_Object.The_Boolean, Where);
when Collection =>
Put (The_Object.The_Collection, Where);
when Undefined =>
Output_Stream.Put ("undefined slot value", Where);
end case;
end Put;
package body Operators is
function "=" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer = Right.The_Integer;
when Boolean =>
return Left.The_Boolean = Right.The_Boolean;
when Collection =>
if Left.The_Collection'Length =
Right.The_Collection'Length then
for I in Left.The_Collection'Range loop
if not (Left.The_Collection (I) =
Right.The_Collection (I)) then
return Standard.False;
end if;
end loop;
end if;
when Undefined =>
null;
end case;
return Standard.True;
else
return Standard.False;
end if;
end "=";
function "<" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer < Right.The_Integer;
when Boolean =>
return Left.The_Boolean < Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "<";
function "<=" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer <= Right.The_Integer;
when Boolean =>
return Left.The_Boolean <= Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "<=";
function ">" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer > Right.The_Integer;
when Boolean =>
return Left.The_Boolean > Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end ">";
function ">=" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer >= Right.The_Integer;
when Boolean =>
return Left.The_Boolean >= Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end ">=";
function "+" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer + Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "+";
function "-" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer - Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "-";
function "*" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer * Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "*";
function "/" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer / Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "/";
function "-" (Right : Object) return Object is
begin
case Right.Kind is
when Integer =>
return Value (-Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
end "-";
function "abs" (Right : Object) return Object is
begin
case Right.Kind is
when Integer =>
return Value (abs Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
end "abs";
end Operators;
end Unconstrained_Array;