[Ada] Define full expansion "flag" to distinguish from reduced Alfa expansion
diff mbox

Message ID 20110830140959.GA28243@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 30, 2011, 2:09 p.m. 
Minor refactoring to clarify where full expansion applies wrt Alfa mode.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-30  Yannick Moy  <moy@adacore.com>

	* opt.adb, opt.ads (Full_Expander_Active): New function defines a
	common shorthand for (Expander_Active and not ALFA_Mode) that can be
	used for testing full expansion, that is active expansion not in the
	reduced mode for Alfa
	* exp_ch4.adb, exp_ch9.adb, exp_disp.adb, sem_ch10.adb, sem_ch12.adb,
	sem_ch6.adb, sem_ch9.adb, sem_res.adb: Use newly defined "flag" instead
	of the verbose (Expander_Active and not ALFA_Mode)

Patch
diff mbox 

Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 178310)
+++ exp_ch9.adb	(working copy)
@@ -4904,9 +4904,7 @@ 
       Ldecl2 : Node_Id;
 
    begin
-      if Expander_Active
-        and then not ALFA_Mode
-      then
+      if Full_Expander_Active then
          --  If we have no handled statement sequence, we may need to build
          --  a dummy sequence consisting of a null statement. This can be
          --  skipped if the trivial accept optimization is permitted.
@@ -5227,9 +5225,7 @@ 
       --  barrier just as a protected function, and discard the protected
       --  version of it because it is never called.
 
-      if Expander_Active
-        and then not ALFA_Mode
-      then
+      if Full_Expander_Active then
          B_F := Build_Barrier_Function (N, Ent, Prot);
          Func := Barrier_Function (Ent);
          Set_Corresponding_Spec (B_F, Func);
@@ -5267,8 +5263,7 @@ 
          --  condition does not reference any of the generated renamings
          --  within the function.
 
-         if Expander_Active
-           and then not ALFA_Mode
+         if Full_Expander_Active
            and then Scope (Entity (Cond)) /= Func
          then
             Set_Declarations (B_F, Empty_List);
@@ -5320,12 +5315,6 @@ 
       Tasknm : Node_Id;
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Aggr := Make_Aggregate (Loc, Component_Associations => New_List);
       Count := 0;
 
@@ -5457,12 +5446,6 @@ 
    --  Start of processing for Expand_N_Accept_Statement
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       --  If accept statement is not part of a list, then its parent must be
       --  an accept alternative, and, as described above, we do not do any
       --  expansion for such accept statements at this level.
@@ -5913,12 +5896,6 @@ 
       T   : Entity_Id;  --  Additional status flag
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Process_Statements_For_Controlled_Objects (Trig);
       Process_Statements_For_Controlled_Objects (Abrt);
 
@@ -6868,12 +6845,6 @@ 
       S : Entity_Id;  --  Primitive operation slot
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Process_Statements_For_Controlled_Objects (N);
 
       if Ada_Version >= Ada_2005
@@ -7190,12 +7161,6 @@ 
    procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Rewrite (N,
         Make_Procedure_Call_Statement (Loc,
           Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc),
@@ -7215,12 +7180,6 @@ 
       Typ : Entity_Id;
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       if Is_RTE (Base_Type (Etype (Expression (N))), RO_CA_Time) then
          Typ := RTE (RO_CA_Delay_Until);
       else
@@ -7241,12 +7200,6 @@ 
 
    procedure Expand_N_Entry_Body (N : Node_Id) is
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       --  Associate discriminals with the next protected operation body to be
       --  expanded.
 
@@ -7268,12 +7221,6 @@ 
       Index   : Node_Id;
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       if No_Run_Time_Mode then
          Error_Msg_CRT ("entry call", N);
          return;
@@ -7330,12 +7277,6 @@ 
       Acc_Ent    : Entity_Id;
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Formal := First_Formal (Entry_Ent);
       Last_Decl := N;
 
@@ -7604,12 +7545,6 @@ 
    --  Start of processing for Expand_N_Protected_Body
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       if No_Run_Time_Mode then
          Error_Msg_CRT ("protected body", N);
          return;
@@ -9162,12 +9097,6 @@ 
    --  Start of processing for Expand_N_Requeue_Statement
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       --  Extract the components of the entry call
 
       Extract_Entry (N, Concval, Ename, Index);
@@ -9754,12 +9683,6 @@ 
    --  Start of processing for Expand_N_Selective_Accept
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Process_Statements_For_Controlled_Objects (N);
 
       --  First insert some declarations before the select. The first is:
@@ -10390,12 +10313,6 @@ 
       --  Used to determine the proper location of wrapper body insertions
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       --  Add renaming declarations for discriminals and a declaration for the
       --  entry family index (if applicable).
 
@@ -11142,12 +11059,6 @@ 
       S : Entity_Id;  --  Primitive operation slot
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       --  Under the Ravenscar profile, timed entry calls are excluded. An error
       --  was already reported on spec, so do not attempt to expand the call.
 
@@ -11592,9 +11503,7 @@ 
          Error_Msg_CRT ("protected body", N);
          return;
 
-      elsif Expander_Active
-        and then not ALFA_Mode
-      then
+      elsif Full_Expander_Active then
          --  Associate discriminals with the first subprogram or entry body to
          --  be expanded.
 
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 178310)
+++ sem_ch9.adb	(working copy)
@@ -727,8 +727,7 @@ 
       --  for the discriminals and privals and finally a declaration for the
       --  entry family index (if applicable).
 
-      if Expander_Active
-        and then not ALFA_Mode
+      if Full_Expander_Active
         and then Is_Protected_Type (P_Type)
       then
          Install_Private_Data_Declarations
@@ -1283,11 +1282,7 @@ 
 
            --  Also skip if expander is not active
 
-           and then Expander_Active
-
-           --  Also skip if in ALFA mode, this expansion is not needed
-
-           and then not ALFA_Mode
+           and then Full_Expander_Active
          then
             Expand_N_Protected_Type_Declaration (N);
             Process_Full_View (N, T, Def_Id);
@@ -2094,10 +2089,7 @@ 
 
            --  Also skip if expander is not active
 
-           and then Expander_Active
-
-           --  Or if in ALFA mode, this expansion is not needed
-           and then not ALFA_Mode
+           and then Full_Expander_Active
          then
             Expand_N_Task_Type_Declaration (N);
             Process_Full_View (N, T, Def_Id);
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 178293)
+++ sem_ch10.adb	(working copy)
@@ -2289,7 +2289,7 @@ 
          --  expansion is active, because the context may be generic and the
          --  flag not defined yet.
 
-         if Expander_Active then
+         if Full_Expander_Active then
             Insert_After (N,
               Make_Assignment_Statement (Loc,
                 Name =>
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 178308)
+++ sem_ch12.adb	(working copy)
@@ -4050,11 +4050,10 @@ 
       if (Is_In_Main_Unit (N)
            or else Is_Inlined (Subp)
            or else Is_Inlined (Alias (Subp)))
-        and then not ALFA_Mode
         and then (Operating_Mode = Generate_Code
                    or else (Operating_Mode = Check_Semantics
                              and then ASIS_Mode))
-        and then (Expander_Active or else ASIS_Mode)
+        and then (Full_Expander_Active or else ASIS_Mode)
         and then not ABE_Is_Certain (N)
         and then not Is_Eliminated (Subp)
       then
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 178310)
+++ sem_res.adb	(working copy)
@@ -3442,8 +3442,7 @@ 
             elsif Nkind (A) = N_Function_Call
               and then Is_Limited_Record (Etype (F))
               and then not Is_Constrained (Etype (F))
-              and then Expander_Active
-              and then not ALFA_Mode
+              and then Full_Expander_Active
               and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F)))
             then
                Establish_Transient_Scope (A, False);
@@ -3458,8 +3457,7 @@ 
 
             elsif Nkind (A) = N_Op_Concat
               and then Nkind (N) = N_Procedure_Call_Statement
-              and then Expander_Active
-              and then not ALFA_Mode
+              and then Full_Expander_Active
               and then
                 not (Is_Intrinsic_Subprogram (Nam)
                       and then Chars (Nam) = Name_Asm)
@@ -3522,8 +3520,7 @@ 
                      --  be removed in the expansion of the wrapped construct.
 
                      if (Is_Controlled (DDT) or else Has_Task (DDT))
-                       and then Expander_Active
-                       and then not ALFA_Mode
+                       and then Full_Expander_Active
                      then
                         Establish_Transient_Scope (A, False);
                      end if;
@@ -5494,8 +5491,7 @@ 
       then
          null;
 
-      elsif Expander_Active
-        and then not ALFA_Mode
+      elsif Full_Expander_Active
         and then Is_Type (Etype (Nam))
         and then Requires_Transient_Scope (Etype (Nam))
         and then
@@ -6616,8 +6612,7 @@ 
       --  Protected functions can return on the secondary stack, in which
       --  case we must trigger the transient scope mechanism.
 
-      elsif Expander_Active
-        and then not ALFA_Mode
+      elsif Full_Expander_Active
         and then Requires_Transient_Scope (Etype (Nam))
       then
          Establish_Transient_Scope (N, Sec_Stack => True);
@@ -8088,8 +8083,6 @@ 
 
    procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
    begin
-      --  Normal mode (not ALFA)
-
       if not ALFA_Mode then
 
          --  The loop structure is already resolved during its analysis, only
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 178303)
+++ exp_ch4.adb	(working copy)
@@ -7258,10 +7258,9 @@ 
          end;
       end if;
 
-      --  Only array types need any other processing. In formal verification
-      --  mode, no other processing is done.
+      --  Only array types need any other processing
 
-      if not Is_Array_Type (Typ) or else ALFA_Mode then
+      if not Is_Array_Type (Typ) then
          return;
       end if;
 
@@ -7717,13 +7716,6 @@ 
       Test         : Node_Id;
 
    begin
-      --  Do not expand quantified expressions in ALFA mode
-      --  why not???
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier => Tnn,
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 178310)
+++ sem_ch6.adb	(working copy)
@@ -2709,8 +2709,7 @@ 
       --  when the Expander is active because Install_Private_Data_Declarations
       --  references entities which were created during regular expansion.
 
-      if Expander_Active
-        and then not ALFA_Mode
+      if Full_Expander_Active
         and then Comes_From_Source (N)
         and then Present (Prot_Typ)
         and then Present (Spec_Id)
@@ -9787,10 +9786,9 @@ 
                --  If expansion is active, the formal is replaced by a local
                --  variable that renames the corresponding entry of the
                --  parameter block, and it is this local variable that may
-               --  require an actual subtype. In ALFA mode, expansion of accept
-               --  statements is skipped.
+               --  require an actual subtype.
 
-               if Expander_Active and not ALFA_Mode then
+               if Full_Expander_Active then
                   Decl := Build_Actual_Subtype (T, Renamed_Object (Formal));
                else
                   Decl := Build_Actual_Subtype (T, Formal);
@@ -9829,8 +9827,7 @@ 
             end if;
 
             if Nkind (N) = N_Accept_Statement
-              and then Expander_Active
-              and then not ALFA_Mode
+              and then Full_Expander_Active
             then
                Set_Actual_Subtype (Renamed_Object (Formal),
                  Defining_Identifier (Decl));
Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 178310)
+++ exp_disp.adb	(working copy)
@@ -697,12 +697,8 @@ 
       --  Expand_Dispatching_Call is called directly from the semantics,
       --  so we only proceed if the expander is active.
 
-      if not Expander_Active
+      if not Full_Expander_Active
 
-        --  And this expansion is not required in special ALFA mode expansion
-
-        or else ALFA_Mode
-
         --  And there is no need to expand the call if we are compiling under
         --  restriction No_Dispatching_Calls; the semantic analyzer has
         --  previously notified the violation of this restriction.
Index: opt.adb
===================================================================
--- opt.adb	(revision 178293)
+++ opt.adb	(working copy)
@@ -38,6 +38,15 @@ 
    SU : constant := Storage_Unit;
    --  Shorthand for System.Storage_Unit
 
+   --------------------------
+   -- Full_Expander_Active --
+   --------------------------
+
+   function Full_Expander_Active return Boolean is
+   begin
+      return Expander_Active and not ALFA_Mode;
+   end Full_Expander_Active;
+
    ----------------------------------
    -- Register_Opt_Config_Switches --
    ----------------------------------
Index: opt.ads
===================================================================
--- opt.ads	(revision 178293)
+++ opt.ads	(working copy)
@@ -1832,6 +1832,14 @@ 
    --  behavior can be disabled using switch -gnatd.t which will set this flag
    --  to False and revert to the previous dynamic behavior.
 
+   function Full_Expander_Active return Boolean;
+   --  Returns the value of (Expander_Active and not ALFA_Mode). This "flag"
+   --  indicates that expansion is fully active, that is, not in the reduced
+   --  mode for Alfa (True) or that expansion is either deactivated, or active
+   --  in the reduced mode for Alfa (False). For more information on full
+   --  expansion, see package Expander. For more information on reduced
+   --  Alfa expansion, see package Exp_Alfa.
+
    -----------------------
    -- Tree I/O Routines --
    -----------------------