⟦ff95375fa⟧

E3 Source Code



with Lrm_Utilities;
with Statement_Traversal;
with Bounds_Utilities;
with Lrm_Renames;
use Lrm_Renames;
package body Branch_Utilities is

    type Depth_Data is
        record
            Current_Depth : Natural;
            Max_Depth     : Natural;
        end record;

    procedure Find_Pre_Op (Program_Element :        Ada.Element;
                           State           : in out Boolean;
                           Control         : in out Ada.Traversal_Control) is
    begin
        case Kind (Program_Element) is
            when Not_A_Branch =>
                Control := Ada.Continue;
            when others =>
                State   := True;
                Control := Ada.Terminate_Immediately;
                Control := Ada.Continue;
        end case;
    end Find_Pre_Op;

    procedure Find_Post_Op (Program_Element :        Ada.Element;
                            State           : in out Boolean;
                            Control         : in out Ada.Traversal_Control) is
    begin
        Control := Ada.Continue;
    end Find_Post_Op;

    procedure Check_For_Branches is new Statement_Traversal
                                           (Boolean, Find_Pre_Op, Find_Post_Op);

    procedure Pre_Op (A_Statement :        Ada.Statement;
                      State       : in out Depth_Data;
                      Control     : in out Ada.Traversal_Control) is
    begin
        case Kind (A_Statement) is
            when Not_A_Branch =>
                null;
            when others =>
                State.Current_Depth := State.Current_Depth + 1;
        end case;
        case Kind (A_Statement) is

            when Raise_Statement | Return_Statement =>
                Control := Ada.Abandon_Siblings;

            when others =>
                Control := Ada.Continue;
        end case;

    end Pre_Op;

    procedure Post_Op (A_Statement :        Ada.Statement;
                       State       : in out Depth_Data;
                       Control     : in out Ada.Traversal_Control) is
    begin
        case Kind (A_Statement) is
            when Not_A_Branch =>
                null;
            when others =>
                if State.Current_Depth > State.Max_Depth then
                    State.Max_Depth := State.Current_Depth;
                end if;
                State.Current_Depth := State.Current_Depth - 1;
        end case;
        case Kind (A_Statement) is
            when Raise_Statement | Return_Statement =>
                Control := Ada.Abandon_Siblings;
            when others =>
                Control := Ada.Continue;
        end case;
    end Post_Op;

    procedure Traverse_Statements is
       new Statement_Traversal (Depth_Data, Pre_Op, Post_Op);

    function Branching_Depth
                (For_Subprogram : Ada_Program.Declaration) return Natural is
        Data        : Depth_Data            := (0, 0);
        The_Control : Ada.Traversal_Control := Ada.Continue;
    begin
        Traverse_Statements (For_Subprogram, Data, The_Control);
        return Data.Max_Depth;
    end Branching_Depth;

    function Kind (The_Statement : Ada_Program.Statement) return Branch_Kind is
        Static               : Boolean;
        Upper, Lower         : Long_Integer;
        Upper_Exp, Lower_Exp : Ada.Element;
    begin
        case Stmts.Kind (The_Statement) is
            when Stmts.A_Case_Statement =>
                return Case_Statement;
            when Stmts.An_If_Statement =>
                return If_Statement;
            when Stmts.An_Exit_Statement =>
                if not (Ada.Is_Nil (Stmts.Exit_Condition (The_Statement))) then
                    return Exit_When;
                else
                    return Not_A_Branch;
                end if;
            when Stmts.A_Loop_Statement =>
                case Stmts.Loop_Kind (The_Statement) is
                    when Stmts.A_While_Loop =>
                        return While_Loop;
                    when Stmts.A_For_Loop =>
                        Bounds_Utilities.Find_Range
                           (Stmts.For_Loop_Index (The_Statement),  
                            Lower,  
                            Upper,  
                            Static,  
                            Lower_Exp,  
                            Upper_Exp);
                        if not Static then
                            return Non_Static_For_Loop;
                        else
                            return Not_A_Branch;
                        end if;
                    when others =>
                        return Not_A_Branch;
                end case;
            when Stmts.A_Select_Statement =>
                return Select_Statement;
            when Stmts.A_Raise_Statement =>
                return Raise_Statement;
            when Stmts.A_Return_Statement =>
                return Return_Statement;
            when Stmts.Not_A_Statement =>
                raise Ada.Inappropriate_Program_Element;
            when others =>
                return Not_A_Branch;
        end case;
    end Kind;

    function No_Branches (In_Statement_List : Ada_Program.Element_Iterator)
                         return Boolean is
        Iter        : Ada.Element_Iterator  := In_Statement_List;
        Found       : Boolean               := False;
        The_Control : Ada.Traversal_Control := Ada.Continue;
    begin
        while not Ada.Done (Iter) loop
            Check_For_Branches (Ada.Value (Iter), Found, The_Control);
            if Found then
                return False;
            end if;
            Ada.Next (Iter);
        end loop;
        return True;
    end No_Branches;

    function No_Else_Part
                (If_Statement : Ada_Program.Statement) return Boolean is
        Arms : Ada.Element_Iterator := Stmts.If_Arm_List (If_Statement);
    begin
        while not Ada.Done (Arms) loop
            if Stmts.Is_Else_Arm (Ada.Value (Arms)) then
                return False;
            end if;
            Ada.Next (Arms);
        end loop;
        return True;
    end No_Else_Part;

    function Width (Of_Branch_Statement : Ada_Program.Statement)
                   return Positive is
        The_Kind : Branch_Kind := Kind (Of_Branch_Statement);
        Arms     : Ada.Element_Iterator;
    begin
        case The_Kind is
            when If_Statement =>
                Arms := Stmts.If_Arm_List (Of_Branch_Statement);
                return Lrm_Utilities.Count (Arms);
            when Case_Statement =>
                Arms := Stmts.Case_Arms_List (Of_Branch_Statement);
                return Lrm_Utilities.Count (Arms);
            when While_Loop | Non_Static_For_Loop | Exit_When =>
                return 2;
            when Select_Statement =>
                Arms := Stmts.Select_Alternatives (Of_Branch_Statement);
                return Lrm_Utilities.Count (Arms);
            when Raise_Statement | Return_Statement =>
                return 1;
            when Not_A_Branch =>
                return 1;
        end case;
    end Width;
end Branch_Utilities;
DataMuseum.dk

Rational R1000/400

⟦ff95375fa⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
