-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Debug_A; use Debug_A;
with Errout; use Errout;
with Exp_Aggr; use Exp_Aggr;
+with Exp_Alfa; use Exp_Alfa;
with Exp_Attr; use Exp_Attr;
with Exp_Ch2; use Exp_Ch2;
with Exp_Ch3; use Exp_Ch3;
-- Local Data --
----------------
- -- The following table is used to save values of the Expander_Active
- -- flag when they are saved by Expander_Mode_Save_And_Set. We use an
- -- extendible table (which is a bit of overkill) because it is easier
- -- than figuring out a maximum value or bothering with range checks!
+ -- The following table is used to save values of the Expander_Active flag
+ -- when they are saved by Expander_Mode_Save_And_Set. We use an extendible
+ -- table (which is a bit of overkill) because it is easier than figuring
+ -- out a maximum value or bothering with range checks!
package Expander_Flags is new Table.Table (
Table_Component_Type => Boolean,
procedure Expand (N : Node_Id) is
begin
- -- If we were analyzing a default expression the Full_Analysis flag
- -- must be off. If we are in expansion mode then we must be
- -- performing a full analysis. If we are analyzing a generic then
- -- Expansion must be off.
+ -- If we were analyzing a default expression (or other spec expression)
+ -- the Full_Analysis flag must be off. If we are in expansion mode then
+ -- we must be performing a full analysis. If we are analyzing a generic
+ -- then Expansion must be off.
pragma Assert
- (not (Full_Analysis and then In_Default_Expression)
- and then (Full_Analysis or else not Expander_Active)
- and then not (Inside_A_Generic and then Expander_Active));
+ (not (Full_Analysis and then In_Spec_Expression)
+ and then (Full_Analysis or else not Expander_Active)
+ and then not (Inside_A_Generic and then Expander_Active));
- -- There are three reasons for the Expander_Active flag to be false.
+ -- There are three reasons for the Expander_Active flag to be false
--
-- The first is when are not generating code. In this mode the
-- Full_Analysis flag indicates whether we are performing a complete
-- info on this.
--
-- The second reason for the Expander_Active flag to be False is that
- -- we are performing a pre-analysis. During pre-analysis all
- -- expansion activity is turned off to make sure nodes are
- -- semantically decorated but no extra nodes are generated. This is
- -- for instance needed for the first pass of aggregate semantic
- -- processing. Note that in this case the Full_Analysis flag is set
- -- to False because the node will subsequently be re-analyzed with
- -- expansion on (see the spec of sem).
+ -- we are performing a pre-analysis. During pre-analysis all expansion
+ -- activity is turned off to make sure nodes are semantically decorated
+ -- but no extra nodes are generated. This is for instance needed for
+ -- the first pass of aggregate semantic processing. Note that in this
+ -- case the Full_Analysis flag is set to False because the node will
+ -- subsequently be re-analyzed with expansion on (see the spec of sem).
-- Finally, expansion is turned off in a regular compilation if there
-- are serious errors. In that case there will be no further expansion,
-- but one cleanup action may be required: if a transient scope was
- -- created (e.g. for a function that returns an unconstrained type)
- -- the scope may still be on the stack, and must be removed explicitly,
+ -- created (e.g. for a function that returns an unconstrained type) the
+ -- scope may still be on the stack, and must be removed explicitly,
-- given that the expansion actions that would normally process it will
-- not take place. This prevents cascaded errors due to stack mismatch.
Debug_A_Entry ("expanding ", N);
-- Processing depends on node kind. For full details on the expansion
- -- activity required in each case, see bodies of corresponding
- -- expand routines
+ -- activity required in each case, see bodies of corresponding expand
+ -- routines.
begin
- case Nkind (N) is
+ if ALFA_Mode then
+ Expand_Alfa (N);
+
+ else
+
+ case Nkind (N) is
when N_Abort_Statement =>
Expand_N_Abort_Statement (N);
when N_Block_Statement =>
Expand_N_Block_Statement (N);
+ when N_Case_Expression =>
+ Expand_N_Case_Expression (N);
+
when N_Case_Statement =>
Expand_N_Case_Statement (N);
when N_Explicit_Dereference =>
Expand_N_Explicit_Dereference (N);
+ when N_Expression_With_Actions =>
+ Expand_N_Expression_With_Actions (N);
+
+ when N_Extended_Return_Statement =>
+ Expand_N_Extended_Return_Statement (N);
+
when N_Extension_Aggregate =>
Expand_N_Extension_Aggregate (N);
+ when N_Free_Statement =>
+ Expand_N_Free_Statement (N);
+
when N_Freeze_Entity =>
Expand_N_Freeze_Entity (N);
when N_Package_Renaming_Declaration =>
Expand_N_Package_Renaming_Declaration (N);
+ when N_Subprogram_Renaming_Declaration =>
+ Expand_N_Subprogram_Renaming_Declaration (N);
+
when N_Pragma =>
Expand_N_Pragma (N);
when N_Qualified_Expression =>
Expand_N_Qualified_Expression (N);
+ when N_Quantified_Expression =>
+ Expand_N_Quantified_Expression (N);
+
when N_Raise_Statement =>
Expand_N_Raise_Statement (N);
when N_Requeue_Statement =>
Expand_N_Requeue_Statement (N);
- when N_Return_Statement =>
- Expand_N_Return_Statement (N);
+ when N_Simple_Return_Statement =>
+ Expand_N_Simple_Return_Statement (N);
when N_Selected_Component =>
Expand_N_Selected_Component (N);
when others => null;
- end case;
+ end case;
+
+ end if;
exception
when RE_Not_Available =>
-- Deal with transient scopes
if Scope_Is_Transient and then N = Node_To_Be_Wrapped then
-
case Nkind (N) is
when N_Statement_Other_Than_Procedure_Call |
N_Procedure_Call_Statement =>
Debug_A_Exit ("expanding ", N, " (done)");
end if;
-
end Expand;
---------------------------
Expander_Active := Expander_Flags.Table (Expander_Flags.Last);
Expander_Flags.Decrement_Last;
- -- Keep expander off if serious errors detected. In this case we do
- -- not need expansion, and continued expansion may cause cascaded
- -- errors or compiler bombs.
+ -- Keep expander off if serious errors detected. In this case we do not
+ -- need expansion, and continued expansion may cause cascaded errors or
+ -- compiler bombs.
if Serious_Errors_Detected /= 0 then
Expander_Active := False;
OSDN Git Service
