|
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: 7594 (0x1daa)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Arguments;
with Block_Class;
with Msg_Report;
with Object;
with String_Class;
with String_Utilities;
package body Boolean_Class is
function Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
-- creation d'un objet booleen
-- ===========================
function Create (Value : Boolean) return Object.Reference is
use Object;
Val : Integer;
begin
if Value then
Val := 1;
else
Val := 0;
end if;
return Object.Create (C_Boolean, Val);
end Create;
function Unary_Msg_Not (The_Object : Object.Reference)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if Value = 0 then
return Create (True);
else
return Create (False);
end if;
end Unary_Msg_Not;
function Unary_Msg_Image (The_Object : Object.Reference)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if Value = 0 then
Msg_Report.Information ("Boolean object = False");
return String_Class.Create (Predefined_False);
else
Msg_Report.Information ("Boolean object = True");
return String_Class.Create (Predefined_True);
end if;
end Unary_Msg_Image;
function Binary_Msg_Or (The_Object : Object.Reference; Arg_Value : Integer)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if (Value = 1) or (Arg_Value = 1) then
return Create (True);
else
return Create (False);
end if;
end Binary_Msg_Or;
function Binary_Msg_And (The_Object : Object.Reference; Arg_Value : Integer)
return Object.Reference is
Value : Integer;
begin
Value := Object.Identificator (The_Object);
if (Value = 1) and (Arg_Value = 1) then
return Create (True);
else
return Create (False);
end if;
end Binary_Msg_And;
function Keyword_Msg_If_True (The_Object, Arg_Object : Object.Reference)
return Object.Reference is
use Object;
Value : Integer;
New_Msg : Message.Selector;
begin
Value := Object.Identificator (The_Object);
if (Value = 1) then
Message.Copy (New_Msg, Block_Class.Evaluate_Msg);
return Block_Class.Send (Arg_Object, New_Msg);
else
return Object.Void_Reference;
end if;
end Keyword_Msg_If_True;
function Keyword_Msg_If_False (The_Object, Arg_Object : Object.Reference)
return Object.Reference is
use Object;
Value : Integer;
New_Msg : Message.Selector;
begin
Value := Object.Identificator (The_Object);
if (Value = 0) then
Message.Copy (New_Msg, Block_Class.Evaluate_Msg);
return Block_Class.Send (Arg_Object, New_Msg);
else
return Object.Void_Reference;
end if;
end Keyword_Msg_If_False;
-- envoi d'un message a un objet booleen
-- =====================================
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List := Arguments.Void_Arguments)
return Object.Reference is
use Object;
Nb_Argument : Natural;
Msg_List, Msg : Message.Selector := Message.Void_Selector;
Arg_Object, Temporary_Result : Object.Reference;
Result : Object.Reference := Object.Void_Reference;
Arg_Value : Integer;
Arg_List : Arguments.List;
begin
Nb_Argument := Arguments.How_Many (With_Arguments);
if Nb_Argument = 0 then
-- reception d'un message unaire
if Is_Equal_String (Message.Image (The_Message), "Non") then
Msg_Report.Information ("Boolean object: unary message -> Non");
Result := Unary_Msg_Not (To_Object);
elsif Is_Equal_String (Message.Image (The_Message), "EnTexte") then
Msg_Report.Information
("Boolean object: unary message -> Entexte");
Result := Unary_Msg_Image (To_Object);
else
Msg_Report.Interpret_Error
("Incorrect unary method " &
Message.Image (The_Message) & " for Boolean object");
raise Incorrect_Method;
end if;
elsif not Message.Is_Keyword (The_Message) then
-- reception d'un message binaire
Arg_List := With_Arguments;
Arguments.First (Arg_List);
Arguments.Read (Arg_List, Arg_Object);
Arg_Value := Object.Identificator (Arg_Object);
if Is_Equal_String (Message.Image (The_Message), "|") then
Msg_Report.Information ("Boolean object: binary message -> |");
Result := Binary_Msg_Or (To_Object, Arg_Value);
elsif Is_Equal_String (Message.Image (The_Message), "&") then
Msg_Report.Information ("Boolean object: binary message -> &");
Result := Binary_Msg_And (To_Object, Arg_Value);
else
Msg_Report.Interpret_Error
("Incorrect binary method " &
Message.Image (The_Message) & " for Boolean object");
raise Incorrect_Method;
end if;
else
-- reception d'un message a mots cles
Message.Cat (Msg_List, The_Message);
Arg_List := With_Arguments;
Arguments.First (Arg_List);
while (Nb_Argument /= 0) loop
Arguments.Read (Arg_List, Arg_Object);
Nb_Argument := Nb_Argument - 1;
Message.Extract_Keyword (Msg_List, Msg);
if Is_Equal_String (Message.Image (Msg), "SiVrai") then
Msg_Report.Information
("Boolean object: keyword message -> SiVrai:");
Temporary_Result := Keyword_Msg_If_True
(To_Object, Arg_Object);
if Temporary_Result /= Object.Void_Reference then
Result := Temporary_Result;
end if;
elsif Is_Equal_String (Message.Image (Msg), "SiFaux") then
Msg_Report.Information
("Boolean object: keyword message -> SiFaux:");
Temporary_Result := Keyword_Msg_If_False
(To_Object, Arg_Object);
if Temporary_Result /= Object.Void_Reference then
Result := Temporary_Result;
end if;
else
-- message inexistant
Msg_Report.Interpret_Error
("Incorrect keyword method " &
Message.Image (Msg) & " for Boolean object");
raise Incorrect_Method;
end if;
end loop;
end if;
return Result;
end Send;
end Boolean_Class;