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;