|
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: 8237 (0x202d)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Ada_Program;
with Diana;
package body Boolean_Expressions is
subtype Logical_Operator is Operator range And_Operator .. Xor_Operator;
subtype Relational_Operator is Operator
range Equal .. Greater_Than_Or_Equal;
subtype Short_Circuit_Operator is
Operator range And_Then_Operator .. Or_Else_Operator;
subtype Unary_Not_Operator is Operator range Not_Operator .. Not_Operator;
Other_Operator : exception;
package Ap 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 Short_Circuit_Operator =>
return Expression;
end case;
end Kind;
function Get_Operator (Node : Diana.Tree) return Operator is
Name : constant String := Diana.Image (Diana.Lx_Symrep (Node));
begin
if Name = "and" then
return And_Operator;
elsif Name = "or" then
return Or_Operator;
elsif Name = "xor" then
return Xor_Operator;
elsif Name = "not" then
return Not_Operator;
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 Get_Operator;
function Kind (An_Expression : Ada_Program.Element)
return Expression_Kind is
Local : Diana.Tree := Ap.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 =>
return Kind (Expression_Operator
(Ap.Conversion.Convert (Local)));
when Diana.Dn_Binary =>
return Kind (Expression_Operator
(Ap.Conversion.Convert (Local)));
when Diana.Dn_Numeric_Literal =>
return Literal;
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 others =>
return Not_An_Expression;
end case;
end loop;
exception
when Other_Operator =>
return Other_Atom;
when Program_Error =>
return Not_An_Expression;
end Kind;
function Expression_Operator
(An_Expression : Ada_Program.Element) return Operator is
Local : Diana.Tree := Ap.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_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_Operator;
when Diana.Dn_And_Then =>
return And_Then_Operator;
when others =>
raise Program_Error;
end case;
when Diana.Dn_Selected =>
Local := Diana.As_Designator_Char (Local);
when others =>
raise Program_Error;
end case;
end loop;
end Expression_Operator;
function Get_Arg (List : Diana.Seq_Type; Arg_Num : Positive)
return Ap.Element is
Local : Diana.Seq_Type := List;
begin
for I in 1 .. Arg_Num - 1 loop
Local := Diana.Tail (Local);
end loop;
return Ap.Conversion.Convert (Diana.Head (Local));
end Get_Arg;
function Left_Argument (An_Expression : Ada_Program.Element)
return Ada_Program.Element is
Local : Diana.Tree := Ap.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 Ap.Conversion.Convert (Diana.As_Exp1 (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 := Ap.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 Ap.Conversion.Convert (Diana.As_Exp2 (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 := Ap.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 (O : Operator) return String is
begin
case O is
when And_Operator =>
return "and";
when Or_Operator =>
return "or";
when Xor_Operator =>
return "xor";
when And_Then_Operator =>
return "and then";
when Or_Else_Operator =>
return "or else";
when Not_Operator =>
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 ">=";
end case;
end Image;
end Boolean_Expressions;