|
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: 11829 (0x2e35)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
with String_Utilities;
with Bounded_String;
with Error_Broadcaster;
with Text_Io;
with Random;
package body Integer_Class is
type Binary_Message is (Plus, Minus, Mul, Div, Less, Greater, Equal,
Less_Equal, Greater_Equal, Different);
type Unary_Message is (Absolut, Aucube, Entexte,
Oppose, Aucarre, Randomize);
function Create (Value : Object.Message) return Object.Reference is
Obj : Object.Reference;
Result : Boolean;
begin
String_Utilities.String_To_Number
(Bounded_String.Image (Value), Obj.Identity, Result);
return (Object.Tiny_Integer, Obj.Identity);
end Create;
function Translate_To_Tiny_Boolean
(To_Object : Object.Reference;
The_Message : Binary_Message;
The_Argument : Object.Reference) return Object.Reference is
Obj : Object.Reference;
begin
case The_Message is
when Less =>
Obj.Class := Object.Tiny_Boolean;
if (To_Object.Identity < The_Argument.Identity) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Greater =>
Obj.Class := Object.Tiny_Boolean;
if (To_Object.Identity > The_Argument.Identity) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Equal =>
Obj.Class := Object.Tiny_Boolean;
if (To_Object.Identity = The_Argument.Identity) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Less_Equal =>
Obj.Class := Object.Tiny_Boolean;
if (To_Object.Identity <= The_Argument.Identity) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Greater_Equal =>
Obj.Class := Object.Tiny_Boolean;
if (To_Object.Identity >= The_Argument.Identity) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Different =>
Obj.Class := Object.Tiny_Boolean;
if (To_Object.Identity /= The_Argument.Identity) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Plus | Minus | Mul | Div =>
null;
end case;
return (Obj);
end Translate_To_Tiny_Boolean;
function Translate_To_Binary_Message
(The_Message : Object.Message) return Binary_Message is
begin
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "=", True) then
return (Equal);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "<", True) then
return (Less);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), ">", True) then
return (Greater);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "<=", True) then
return (Less_Equal);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), ">=", True) then
return (Greater_Equal);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "<>", True) then
return (Different);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "+", True) then
return (Plus);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "-", True) then
return (Minus);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "*", True) then
return (Mul);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "/", True) then
return (Div);
end if;
if True then
raise Error_Broadcaster.Unknown_Binary_Message;
end if;
end Translate_To_Binary_Message;
function Entexte (To_Object : Object.Reference) return String is
begin
return
String_Utilities.Number_To_String (To_Object.Identity, 10, 6);
end Entexte;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return String is
Message : Unary_Message;
begin
Message := Unary_Message'Value (Bounded_String.Image (The_Message));
case Message is
when Absolut | Randomize | Aucube | Oppose | Aucarre =>
return ("");
when Entexte =>
return Entexte (To_Object);
end case;
end Send;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return Object.Reference is
Message : Unary_Message;
Obj : Object.Reference;
Tiny_Handle : Random.Handle;
begin
Message := Unary_Message'Value (Bounded_String.Image (The_Message));
Obj := To_Object;
case Message is
when Absolut =>
Obj.Identity := abs (To_Object.Identity);
Obj.Class := Object.Tiny_Integer;
when Aucube =>
Obj.Identity := To_Object.Identity ** 3;
Obj.Class := Object.Tiny_Integer;
when Entexte =>
Text_Io.Put (String_Utilities.Number_To_String
(To_Object.Identity));
Obj.Identity := To_Object.Identity;
Obj.Class := To_Object.Class;
when Oppose =>
Obj.Identity := -1 * To_Object.Identity;
Obj.Class := Object.Tiny_Integer;
when Aucarre =>
Obj.Identity := To_Object.Identity ** 2;
Obj.Class := Object.Tiny_Integer;
when Randomize =>
Random.Initialize (Tiny_Handle);
Obj.Identity := Integer
(Random.Natural_Value
(Tiny_Handle, abs (To_Object.Identity)));
Obj.Class := Object.Tiny_Integer;
end case;
return Obj;
exception
when Constraint_Error =>
raise Error_Broadcaster.Unknown_Unary_Message;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Object.Message;
The_Argument : Object.Reference) return Object.Reference is
Message : Binary_Message;
Obj : Object.Reference;
begin
Message := Translate_To_Binary_Message (The_Message);
case Message is
when Plus =>
Obj.Identity := To_Object.Identity + The_Argument.Identity;
Obj.Class := Object.Tiny_Integer;
when Minus =>
Obj.Identity := To_Object.Identity - The_Argument.Identity;
Obj.Class := Object.Tiny_Integer;
when Mul =>
Obj.Identity := To_Object.Identity * The_Argument.Identity;
Obj.Class := Object.Tiny_Integer;
when Div =>
if The_Argument.Identity /= 0 then
Obj.Identity := To_Object.Identity / The_Argument.Identity;
Obj.Class := Object.Tiny_Integer;
else
raise Error_Broadcaster.Divide_By_Zero;
end if;
when Less =>
Obj := Translate_To_Tiny_Boolean
(To_Object, Message, The_Argument);
when Greater =>
Obj := Translate_To_Tiny_Boolean
(To_Object, Message, The_Argument);
when Equal =>
Obj := Translate_To_Tiny_Boolean
(To_Object, Message, The_Argument);
when Less_Equal =>
Obj := Translate_To_Tiny_Boolean
(To_Object, Message, The_Argument);
when Greater_Equal =>
Obj := Translate_To_Tiny_Boolean
(To_Object, Message, The_Argument);
when Different =>
Obj := Translate_To_Tiny_Boolean
(To_Object, Message, The_Argument);
end case;
return Obj;
exception
when Error_Broadcaster.Unknown_Binary_Message =>
raise Error_Broadcaster.Integer_Bad_Type;
when Error_Broadcaster.Divide_By_Zero =>
Error_Broadcaster.Dividebyzero;
raise Error_Broadcaster.Divide_By_Zero;
end Send;
function Send (To_Object : Object.Reference;
The_Argument : Object.Parameters.List)
return Object.Reference is
Bloc_Object, Iteration_Object, Bound_Object, Obj :
Object.Reference := To_Object;
Local_Argument : Object.Parameters.List := The_Argument;
Bloc_Argument : Object.Parameters.List;
The_Message, Iteration_Message : Object.Message;
begin
Bounded_String.Copy (The_Message, "valeur");
if (String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"fois:", True)) then
Object.Parameters.Get (Local_Argument, Bloc_Object);
while (Iteration_Object.Identity /= 0) loop
Obj := (Object.Send (Bloc_Object, The_Message));
Iteration_Object.Identity := Iteration_Object.Identity - 1;
end loop;
return Obj;
elsif (String_Utilities.Equal
(Bounded_String.Image
(Object.Parameters.Selector (Local_Argument)),
"a:repeter:", True)) then
Bounded_String.Copy (The_Message, "valeur:");
Object.Parameters.Get (Local_Argument, Bound_Object);
Object.Parameters.Get (Local_Argument, Bloc_Object);
Object.Parameters.Add (The_Message, Obj, Bloc_Argument);
Object.Parameters.Get (Bloc_Argument, Obj);
if (Bound_Object.Identity >= To_Object.Identity) then
while (Iteration_Object.Identity <= Bound_Object.Identity) loop
Object.Parameters.Add (Iteration_Message,
Iteration_Object, Bloc_Argument);
Obj := Object.Send (Bloc_Object, Bloc_Argument);
Iteration_Object.Identity := Iteration_Object.Identity + 1;
Object.Parameters.Get (Bloc_Argument, Obj);
end loop;
return Iteration_Object;
elsif (Bound_Object.Identity < To_Object.Identity) then
while (Iteration_Object.Identity >= Bound_Object.Identity) loop
Object.Parameters.Add (Iteration_Message,
Iteration_Object, Bloc_Argument);
Obj := Object.Send (Bloc_Object, Bloc_Argument);
Iteration_Object.Identity := Iteration_Object.Identity - 1;
Object.Parameters.Get (Bloc_Argument, Obj);
end loop;
return Iteration_Object;
end if;
else
raise Error_Broadcaster.Unknown_Keyword_Message;
end if;
return To_Object;
end Send;
end Integer_Class;