|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Boolean_Expressions, seg_004616
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Ada_Program;
with Diana;
package body Boolean_Expressions is
Other_Operator : exception;
package Ada renames Ada_Program;
function Kind (Op : Operator) return Expression_Kind is
begin
case Op is
when Unary_Not_Operator =>
return Not_Expression;
when Logical_Operator =>
return Expression;
when Relational_Operator =>
return Relation;
when Membership_Op =>
return Membership;
when Short_Circuit_Operator =>
return Expression;
when Not_An_Operator =>
return Not_An_Expression;
end case;
end Kind;
function Get_Operator (Node : Diana.Tree) return Operator is
begin
case Diana.Kind (Node) is
when Diana.Dn_In_Op =>
return In_Op;
when Diana.Dn_Not_In =>
return Not_In_Op;
when others =>
declare
Name : constant String :=
Diana.Image (Diana.Lx_Symrep (Node));
begin
if Name = "and" then
return And_Op;
elsif Name = "or" then
return Or_Op;
elsif Name = "xor" then
return Xor_Op;
elsif Name = "not" then
return Not_Op;
elsif Name = "=" then
return Equal;
elsif Name = "/=" then
return Not_Equal;
elsif Name = "<" then
return Less_Than;
elsif Name = "<=" then
return Less_Than_Or_Equal;
elsif Name = ">" then
return Greater_Than;
elsif Name = ">=" then
return Greater_Than_Or_Equal;
else
raise Other_Operator;
end if;
end;
end case;
end Get_Operator;
function Kind (An_Expression : Ada_Program.Element)
return Expression_Kind is
Local : Diana.Tree := Ada.Conversion.Convert (An_Expression);
begin
loop
case Diana.Kind (Local) is
when Diana.Dn_Cond_Clause =>
Local := Diana.As_Exp_Void (Local);
when Diana.Dn_Parenthesized =>
Local := Diana.As_Exp (Local);
when Diana.Dn_Selected =>
Local := Diana.As_Designator_Char (Local);
when Diana.Dn_Function_Call =>
return Kind (Expression_Operator
(Ada.Conversion.Convert (Local)));
when Diana.Dn_Binary =>
return Kind (Expression_Operator
(Ada.Conversion.Convert (Local)));
when Diana.Dn_Numeric_Literal =>
return Literal;
when Diana.Dn_Membership =>
return Membership;
when Diana.Dn_Attribute =>
return Attribute;
when Diana.Dn_Used_Object_Id =>
case Diana.Kind (Diana.Sm_Exp_Type (Local)) is
when Diana.Dn_Enum_Literal_S =>
return Literal;
when others =>
return Identifier;
end case;
when Diana.Dn_Range =>
return Membership_Range;
when others =>
return Not_An_Expression;
end case;
end loop;
exception
when Other_Operator =>
return Function_Call;
when Program_Error =>
return Not_An_Expression;
when others =>
return Not_An_Expression;
end Kind;
function Expression_Operator
(An_Expression : Ada_Program.Element) return Operator is
Local : Diana.Tree := Ada.Conversion.Convert (An_Expression);
begin
loop
case Diana.Kind (Local) is
when Diana.Dn_Cond_Clause =>
Local := Diana.As_Exp_Void (Local);
when Diana.Dn_Parenthesized =>
Local := Diana.As_Exp (Local);
when Diana.Dn_Function_Call =>
Local := Diana.As_Name (Local);
when Diana.Dn_Membership =>
return Get_Operator (Diana.As_Membership_Op (Local));
when Diana.Dn_Used_Op =>
return Get_Operator (Local);
when Diana.Dn_Used_Bltn_Op =>
return Get_Operator (Local);
when Diana.Dn_Binary =>
case Diana.Kind (Diana.As_Binary_Op (Local)) is
when Diana.Dn_Or_Else =>
return Or_Else_Op;
when Diana.Dn_And_Then =>
return And_Then_Op;
when others =>
raise Program_Error;
end case;
when Diana.Dn_Selected =>
Local := Diana.As_Designator_Char (Local);
when others =>
raise Other_Operator;
end case;
end loop;
end Expression_Operator;
function Get_Arg (List : Diana.Seq_Type; Arg_Num : Positive)
return Ada.Element is
Local : Diana.Seq_Type := List;
begin
for I in 1 .. Arg_Num - 1 loop
Local := Diana.Tail (Local);
end loop;
return Ada.Conversion.Convert (Diana.Head (Local));
end Get_Arg;
function Left_Argument (An_Expression : Ada_Program.Element)
return Ada_Program.Element is
Local : Diana.Tree := Ada.Conversion.Convert (An_Expression);
begin
loop
case Diana.Kind (Local) is
when Diana.Dn_Parenthesized =>
Local := Diana.As_Exp (Local);
when Diana.Dn_Function_Call =>
Local := Diana.As_Param_Assoc_S (Local);
when Diana.Dn_Param_Assoc_S =>
return Get_Arg (Diana.As_List (Local), 1);
when Diana.Dn_Binary =>
return Ada.Conversion.Convert (Diana.As_Exp1 (Local));
when Diana.Dn_Membership =>
return Ada.Conversion.Convert (Diana.As_Exp (Local));
when others =>
raise Program_Error;
end case; end loop;
end Left_Argument;
function Right_Argument (An_Expression : Ada_Program.Element)
return Ada_Program.Element is
Local : Diana.Tree := Ada.Conversion.Convert (An_Expression);
begin
loop
case Diana.Kind (Local) is
when Diana.Dn_Parenthesized =>
Local := Diana.As_Exp (Local);
when Diana.Dn_Function_Call =>
Local := Diana.As_Param_Assoc_S (Local);
when Diana.Dn_Param_Assoc_S =>
return Get_Arg (Diana.As_List (Local), 2);
when Diana.Dn_Binary =>
return Ada.Conversion.Convert (Diana.As_Exp2 (Local));
when Diana.Dn_Membership =>
return Ada.Conversion.Convert (Diana.As_Type_Range (Local));
when others =>
raise Program_Error;
end case;
end loop;
end Right_Argument;
function Argument (A_Not_Expression : Ada_Program.Element)
return Ada_Program.Element is
Local : Diana.Tree := Ada.Conversion.Convert (A_Not_Expression);
begin
loop
case Diana.Kind (Local) is
when Diana.Dn_Parenthesized =>
Local := Diana.As_Exp (Local);
when Diana.Dn_Function_Call =>
Local := Diana.As_Param_Assoc_S (Local);
when Diana.Dn_Param_Assoc_S =>
return Get_Arg (Diana.As_List (Local), 1);
when others =>
raise Program_Error;
end case;
end loop;
end Argument;
function Image (Op : Operator) return String is
begin
case Op is
when And_Op =>
return "and";
when Or_Op =>
return "or";
when Xor_Op =>
return "xor";
when And_Then_Op =>
return "and then";
when Or_Else_Op =>
return "or else";
when Not_Op =>
return "not";
when Equal =>
return "=";
when Not_Equal =>
return "/=";
when Less_Than =>
return "<";
when Greater_Than =>
return ">";
when Less_Than_Or_Equal =>
return "<=";
when Greater_Than_Or_Equal =>
return ">=";
when In_Op =>
return "in";
when Not_In_Op =>
return "not in";
when Not_An_Operator =>
return "<UNKNOWN>";
end case;
end Image;
end Boolean_Expressions;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=22 rec1=00 rec2=01 rec3=040
[0x01] rec0=18 rec1=00 rec2=02 rec3=03c
[0x02] rec0=18 rec1=00 rec2=03 rec3=044
[0x03] rec0=19 rec1=00 rec2=04 rec3=010
[0x04] rec0=18 rec1=00 rec2=05 rec3=012
[0x05] rec0=19 rec1=00 rec2=06 rec3=006
[0x06] rec0=16 rec1=00 rec2=07 rec3=002
[0x07] rec0=17 rec1=00 rec2=08 rec3=00c
[0x08] rec0=1c rec1=00 rec2=09 rec3=032
[0x09] rec0=1d rec1=00 rec2=0a rec3=000
tail 0x217002450815c65b80806 0x42a00088462061e03