einfo.adb (OK_To_Rename): New flag

2009-04-24  Robert Dewar  <dewar@adacore.com>

	* einfo.adb (OK_To_Rename): New flag

	* einfo.ads (OK_To_Rename): New flag

	* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite as renames if
	OK_To_Rename set.

	* exp_ch4.adb (Expand_Concatenate): Mark temp variable OK_To_Rename

	* sem_ch7.adb (Uninstall_Declarations): Allow for renames from
	OK_To_Rename.

From-SVN: r146714

gcc/ada/ChangeLog

+2009-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.adb (OK_To_Rename): New flag
+
+	* einfo.ads (OK_To_Rename): New flag
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite as renames if
+	OK_To_Rename set.
+
+	* exp_ch4.adb (Expand_Concatenate): Mark temp variable OK_To_Rename
+
+	* sem_ch7.adb (Uninstall_Declarations): Allow for renames from
+	OK_To_Rename.
+
 2009-04-24  Emmanuel Briot  <briot@adacore.com>
 
 	* prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb,

gcc/ada/einfo.adb

@@ -507,8 +507,7 @@ package body Einfo is
    --    Is_RACW_Stub_Type               Flag244
    --    Is_Private_Primitive            Flag245
    --    Is_Underlying_Record_View       Flag246
-
-   --    (unused)                        Flag247
+   --    OK_To_Rename                    Flag247
 
    -----------------------
    -- Local subprograms --
@@ -2292,6 +2291,12 @@ package body Einfo is
       return Uint10 (Id);
    end Normalized_Position_Max;
 
+   function OK_To_Rename (Id : E) return B is
+   begin
+      pragma Assert (Ekind (Id) = E_Variable);
+      return Flag247 (Id);
+   end OK_To_Rename;
+
    function OK_To_Reorder_Components (Id : E) return B is
    begin
       pragma Assert (Is_Record_Type (Id));
@@ -4777,6 +4782,12 @@ package body Einfo is
       Set_Uint10 (Id, V);
    end Set_Normalized_Position_Max;
 
+   procedure Set_OK_To_Rename (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Variable);
+      Set_Flag247 (Id, V);
+   end Set_OK_To_Rename;
+
    procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
    begin
       pragma Assert
@@ -7008,6 +7019,7 @@ package body Einfo is
       W ("No_Strict_Aliasing",              Flag136 (Id));
       W ("Non_Binary_Modulus",              Flag58  (Id));
       W ("Nonzero_Is_True",                 Flag162 (Id));
+      W ("OK_To_Rename",                    Flag247 (Id));
       W ("OK_To_Reorder_Components",        Flag239 (Id));
       W ("Optimize_Alignment_Space",        Flag241 (Id));
       W ("Optimize_Alignment_Time",         Flag242 (Id));

gcc/ada/einfo.ads

@@ -3009,6 +3009,23 @@ package Einfo is
 --       Applies to subprograms and subprogram types. Yields the number of
 --       formals as a value of type Pos.
 
+--    OK_To_Rename (Flag247)
+--       Present only in entities for variables. If this flag is set, it
+--       means that if the entity is used as the initial value of an object
+--       declaration, the object declaration can be safely converted into a
+--       renaming to avoid an extra copy. This is set for variables which are
+--       generated by the expander to hold the result of evaluating some
+--       expression. Most notably, the local variables used to store the result
+--       of concatenations are so marked (see Exp_Ch4.Expand_Concatenate). It
+--       is only worth setting this flag for composites, since for primitive
+--       types, it is cheaper to do the copy.
+
+--    OK_To_Reorder_Components (Flag239) [base type only]
+--       Present in record types. Set if the back end is permitted to reorder
+--       the components. If not set, the record must be layed out in the order
+--       in which the components are declared textually. Currently this flag
+--       can only be set by debug switches.
+
 --    Optimize_Alignment_Space (Flag241)
 --       A flag present in type, subtype, variable, and constant entities. This
 --       flag records that the type or object is to be layed out in a manner
@@ -3032,12 +3049,6 @@ package Einfo is
 --       points to the original array type for which this is the packed
 --       array implementation type.
 
---    OK_To_Reorder_Components (Flag239) [base type only]
---       Present in record types. Set if the back end is permitted to reorder
---       the components. If not set, the record must be layed out in the order
---       in which the components are declared textually. Currently this flag
---       can only be set by debug switches.
-
 --    Original_Record_Component (Node22)
 --       Present in components, including discriminants. The usage depends
 --       on whether the record is a base type and whether it is tagged.
@@ -5397,6 +5408,7 @@ package Einfo is
    --    Is_True_Constant                    (Flag163)
    --    Is_Volatile                         (Flag16)
    --    Is_Return_Object                    (Flag209)
+   --    OK_To_Rename                        (Flag247)
    --    Optimize_Alignment_Space            (Flag241)
    --    Optimize_Alignment_Time             (Flag242)
    --    Treat_As_Volatile                   (Flag41)
@@ -5927,6 +5939,7 @@ package Einfo is
    function Normalized_First_Bit                (Id : E) return U;
    function Normalized_Position                 (Id : E) return U;
    function Normalized_Position_Max             (Id : E) return U;
+   function OK_To_Rename                        (Id : E) return B;
    function OK_To_Reorder_Components            (Id : E) return B;
    function Optimize_Alignment_Space            (Id : E) return B;
    function Optimize_Alignment_Time             (Id : E) return B;
@@ -6480,6 +6493,7 @@ package Einfo is
    procedure Set_Normalized_First_Bit            (Id : E; V : U);
    procedure Set_Normalized_Position             (Id : E; V : U);
    procedure Set_Normalized_Position_Max         (Id : E; V : U);
+   procedure Set_OK_To_Rename                    (Id : E; V : B := True);
    procedure Set_OK_To_Reorder_Components        (Id : E; V : B := True);
    procedure Set_Optimize_Alignment_Space        (Id : E; V : B := True);
    procedure Set_Optimize_Alignment_Time         (Id : E; V : B := True);
@@ -7173,6 +7187,7 @@ package Einfo is
    pragma Inline (Normalized_First_Bit);
    pragma Inline (Normalized_Position);
    pragma Inline (Normalized_Position_Max);
+   pragma Inline (OK_To_Rename);
    pragma Inline (OK_To_Reorder_Components);
    pragma Inline (Optimize_Alignment_Space);
    pragma Inline (Optimize_Alignment_Time);
@@ -7562,6 +7577,7 @@ package Einfo is
    pragma Inline (Set_Normalized_Position);
    pragma Inline (Set_Normalized_Position_Max);
    pragma Inline (Set_OK_To_Reorder_Components);
+   pragma Inline (Set_OK_To_Rename);
    pragma Inline (Set_Optimize_Alignment_Space);
    pragma Inline (Set_Optimize_Alignment_Time);
    pragma Inline (Set_Original_Array_Type);

gcc/ada/exp_ch3.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -4688,6 +4688,40 @@ package body Exp_Ch3 is
                Insert_After_And_Analyze (Init_After, Stat);
             end;
          end if;
+
+         --  Final transformation, if the initializing expression is an entity
+         --  for a variable with OK_To_Rename set, then we transform:
+
+         --     X : typ := expr;
+
+         --  into
+
+         --     X : typ renames expr
+
+         --  provided that X is not aliased. The aliased case has to be
+         --  excluded in general because expr will not be aliased in general.
+
+         if not Aliased_Present (N)
+           and then Is_Entity_Name (Expr_Q)
+           and then Ekind (Entity (Expr_Q)) = E_Variable
+           and then OK_To_Rename (Entity (Expr_Q))
+           and then Is_Entity_Name (Object_Definition (N))
+         then
+            Rewrite (N,
+              Make_Object_Renaming_Declaration (Loc,
+                Defining_Identifier => Defining_Identifier (N),
+                Subtype_Mark        => Object_Definition (N),
+                Name                => Expr_Q));
+
+            --  We do not analyze this renaming declaration, because all its
+            --  components have already been analyzed, and if we were to go
+            --  ahead and analyze it, we would in effect be trying to generate
+            --  another declaration of X, which won't do!
+
+            Set_Renamed_Object (Defining_Identifier (N), Expr_Q);
+            Set_Analyzed (N);
+         end if;
+
       end if;
 
    exception

gcc/ada/exp_ch4.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2805,6 +2805,12 @@ package body Exp_Ch4 is
                       High_Bound => High_Bound))))),
         Suppress => All_Checks);
 
+      --  If the result of the concatenation appears as the initializing
+      --  expression of an object declaration, we can just rename the
+      --  result, rather than copying it.
+
+      Set_OK_To_Rename (Ent);
+
       --  Catch the static out of range case now
 
       if Raises_Constraint_Error (High_Bound) then

gcc/ada/sem_ch7.adb

@@ -2137,13 +2137,38 @@ package body Sem_Ch7 is
                  ("missing full declaration for private extension", Id);
             end if;
 
+         --  Case of constant, check for deferred constant declaration with
+         --  no full view. Likely just a matter of a missing expression, or
+         --  accidental use of the keyword constant.
+
          elsif Ekind (Id) = E_Constant
+
+           --  OK if constant value present
+
            and then No (Constant_Value (Id))
+
+           --  OK if full view present
+
            and then No (Full_View (Id))
+
+           --  OK if imported, since that provides the completion
+
            and then not Is_Imported (Id)
-           and then (Nkind (Parent (Id)) /= N_Object_Declaration
-                      or else not No_Initialization (Parent (Id)))
+
+           --  OK if object declaration replaced by renaming declaration as
+           --  a result of OK_To_Rename processing (e.g. for concatenation)
+
+           and then Nkind (Parent (Id)) /= N_Object_Renaming_Declaration
+
+           --  OK if object declaration with the No_Initialization flag set
+
+           and then not (Nkind (Parent (Id)) = N_Object_Declaration
+                           and then No_Initialization (Parent (Id)))
          then
+            --  If no private declaration is present, we assume the user did
+            --  not intend a deferred constant declaration and the problem
+            --  is simply that the initializing expression is missing.
+
             if not Has_Private_Declaration (Etype (Id)) then
 
                --  We assume that the user did not intend a deferred constant
@@ -2159,6 +2184,9 @@ package body Sem_Ch7 is
                     Parent (Id));
                end if;
 
+            --  Otherwise if a private declaration is present, then we are
+            --  missing the full declaration for the deferred constant.
+
             else
                Error_Msg_N
                   ("missing full declaration for deferred constant (RM 7.4)",