|
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: 12273 (0x2ff1)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Block_Class;
with Boolean_Class;
with Bounded_String;
with Custom;
with Errors;
with Random;
with String_Class;
with String_Utilities;
package body Integer_Class is
type Unary_Message is (Nul, Au_Carre, Au_Cube, Absolu, Negatif,
Oppose, Au_Hasard, Secondes, En_Texte);
type Binary_Message is (Nul, Plus, Moins, Fois, Divise, Modulo, Egal,
Sup, Inf, Sup_Ou_Egal, Inf_Ou_Egal, Different);
type List_Message is (Nul, A_Repeter, Fois);
My_Handle : Random.Handle;
function Convert_To_Unary
(The_Message : Scanner.Lexeme) return Unary_Message is
begin
if Bounded_String.Image (The_Message) = "AU_CARRE" then
return Au_Carre;
elsif Bounded_String.Image (The_Message) = "AU_CUBE" then
return Au_Cube;
elsif Bounded_String.Image (The_Message) = "ABSOLU" then
return Absolu;
elsif Bounded_String.Image (The_Message) = "OPPOSE" then
return Oppose;
elsif Bounded_String.Image (The_Message) = "NEGATIF" then
return Negatif;
elsif Bounded_String.Image (The_Message) = "AU_HASARD" then
return Au_Hasard;
elsif Bounded_String.Image (The_Message) = "SECONDES" then
return Secondes;
elsif Bounded_String.Image (The_Message) = "EN_TEXTE" then
return En_Texte;
else
return Nul;
end if;
end Convert_To_Unary;
function Convert_To_Binary
(The_Message : Scanner.Lexeme) return Binary_Message is
begin
if Bounded_String.Image (The_Message) = "+" then
return Plus;
elsif Bounded_String.Image (The_Message) = "-" then
return Moins;
elsif Bounded_String.Image (The_Message) = "*" then
return Fois;
elsif Bounded_String.Image (The_Message) = "/" then
return Divise;
elsif Bounded_String.Image (The_Message) = "%" then
return Modulo;
elsif Bounded_String.Image (The_Message) = "=" then
return Egal;
elsif Bounded_String.Image (The_Message) = ">" then
return Sup;
elsif Bounded_String.Image (The_Message) = "<" then
return Inf;
elsif Bounded_String.Image (The_Message) = ">=" then
return Sup_Ou_Egal;
elsif Bounded_String.Image (The_Message) = "<=" then
return Inf_Ou_Egal;
elsif Bounded_String.Image (The_Message) = "<>" then
return Different;
else
return Nul;
end if;
end Convert_To_Binary;
procedure Convert_To_List (The_Message : in out Message.Selector;
Back : out List_Message) is
begin
Back := Nul;
case Message.Arg_Number (The_Message) is
when 1 =>
Message.Init (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"FOIS:" then
Back := Fois;
end if;
when 2 =>
Message.Init (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"A:" then
Message.Next (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"REPETER:" then
Back := A_Repeter;
end if;
end if;
when others =>
null;
end case;
end Convert_To_List;
function Create (Value : Integer) return Object.Reference is
Class_Id : Object.Class := Object.Entier;
begin
return (Object.Create (Class_Id, Value));
end Create;
function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
return Object.Reference is
Current_Message : Unary_Message := Nul;
Random_Max : Natural;
begin
Current_Message := Convert_To_Unary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Integer;
when Au_Carre =>
return Create (Object.Get_Id (To_Object) ** 2);
when Au_Cube =>
return Create (Object.Get_Id (To_Object) ** 3);
when Absolu =>
return Create (abs (Object.Get_Id (To_Object)));
when Negatif =>
return Create (-abs (Object.Get_Id (To_Object)));
when Oppose =>
return Create (-Object.Get_Id (To_Object));
when Au_Hasard =>
Random_Max := Random.Natural_Value
(My_Handle, Natural
(Object.Get_Id (To_Object)));
return Create (Integer (Random_Max));
when Secondes =>
delay (Duration (Object.Get_Id (To_Object)));
return Object.Void_Reference;
when En_Texte =>
return String_Class.Create (String_Utilities.Number_To_String
((Object.Get_Id (To_Object))));
end case;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Scanner.Lexeme;
With_Object : Object.Reference) return Object.Reference is
Current_Message : Binary_Message := Nul;
begin
case Object.Get_Class (With_Object) is
when Object.Entier =>
Current_Message := Convert_To_Binary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Integer;
when Plus =>
return Create ((Object.Get_Id (To_Object) +
Object.Get_Id (With_Object)));
when Moins =>
return Create ((Object.Get_Id (To_Object) -
Object.Get_Id (With_Object)));
when Fois =>
return Create ((Object.Get_Id (To_Object) *
Object.Get_Id (With_Object)));
when Divise =>
if Object.Get_Id (With_Object) /= 0 then
return Create ((Object.Get_Id (To_Object) /
Object.Get_Id (With_Object)));
else
raise Errors.Division_By_Zero;
end if;
when Modulo =>
return Create ((Object.Get_Id (To_Object) mod
Object.Get_Id (With_Object)));
when Egal =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) =
Object.Get_Id (With_Object));
when Sup =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) >
Object.Get_Id (With_Object));
when Inf =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) <
Object.Get_Id (With_Object));
when Sup_Ou_Egal =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) >=
Object.Get_Id (With_Object));
when Inf_Ou_Egal =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) <=
Object.Get_Id (With_Object));
when Different =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) /=
Object.Get_Id (With_Object));
end case;
when others =>
raise Errors.Integer_Object_Required_As_Argument;
end case;
end Send;
procedure Send (To_Object : Object.Reference;
The_Message : in out Message.Selector;
With_Arguments : in out Parameters.List;
Back_Object : out Object.Reference) is
Obj1, Obj2 : Object.Reference;
Result : Object.Reference;
Current_Selector : List_Message;
Interpret_Yourself : Scanner.Lexeme :=
Bounded_String.Value ("VALEUR", Custom.String_Max_Length);
Interpret_Yourself_With : Scanner.Lexeme :=
Bounded_String.Value ("VALEUR:", Custom.String_Max_Length);
begin
Convert_To_List (The_Message, Current_Selector);
case Current_Selector is
when Nul =>
raise Errors.Unknown_Message_For_Integer;
when A_Repeter =>
Parameters.Init (With_Arguments);
Obj1 := Parameters.Value (With_Arguments);
case Object.Get_Class (Obj1) is
when Object.Entier =>
Parameters.Next (With_Arguments);
Obj2 := Parameters.Value (With_Arguments);
case Object.Get_Class (Obj2) is
when Object.Bloc =>
Message.Free (The_Message);
Message.Insert
(Interpret_Yourself_With, The_Message);
if Object.Get_Id (To_Object) <=
Object.Get_Id (Obj1) then
for I in Object.Get_Id (To_Object) ..
Object.Get_Id (Obj1) loop
Parameters.Free (With_Arguments);
Parameters.Insert
(Create (I), With_Arguments);
Block_Class.Send
(Obj2, The_Message,
With_Arguments, Result);
Back_Object := Result;
end loop;
else
for I in reverse
Object.Get_Id (Obj1) ..
Object.Get_Id (To_Object) loop
Parameters.Free (With_Arguments);
Parameters.Insert
(Create (I), With_Arguments);
Block_Class.Send
(Obj2, The_Message,
With_Arguments, Result);
Back_Object := Result;
end loop;
end if;
when others =>
raise Errors.
Block_Argument_Required_For_Integer;
end case;
when others =>
raise Errors.Integer_Object_Required_As_Argument;
end case;
when Fois =>
Parameters.Init (With_Arguments);
Obj1 := Parameters.Value (With_Arguments);
case Object.Get_Class (Obj1) is
when Object.Bloc =>
for I in 1 .. Object.Get_Id (To_Object) loop
Back_Object := Block_Class.Send
(Obj1, Interpret_Yourself);
end loop;
when others =>
raise Errors.Block_Argument_Required_For_Integer;
end case;
end case;
end Send;
begin
Random.Initialize (My_Handle);
end Integer_Class;