procedure Put
(S : in out Sink'Class; T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "")
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
is
J : Positive := T'First;
- Used : array (1 .. 6) of Boolean := (others => False);
+ Used : array (1 .. 9) of Boolean := (others => False);
begin
while J <= T'Last loop
if T (J) = '\' then
when '6' =>
Used (6) := True;
Put_UTF_8_Lines (S, X6);
+ when '7' =>
+ Used (7) := True;
+ Put_UTF_8_Lines (S, X7);
+ when '8' =>
+ Used (8) := True;
+ Put_UTF_8_Lines (S, X8);
+ when '9' =>
+ Used (9) := True;
+ Put_UTF_8_Lines (S, X9);
when others =>
raise Program_Error;
if not Used (6) then
pragma Assert (X6 = "");
end if;
+ if not Used (7) then
+ pragma Assert (X7 = "");
+ end if;
+ if not Used (8) then
+ pragma Assert (X8 = "");
+ end if;
+ if not Used (9) then
+ pragma Assert (X9 = "");
+ end if;
Flush (S);
end Put;
procedure Put
(T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "") is
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "") is
begin
- Put (Files.Standard_Output.all, T, X1, X2, X3, X4, X5, X6);
+ Put (Files.Standard_Output.all, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
end Put;
procedure Err
(T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "") is
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "") is
begin
- Put (Files.Standard_Error.all, T, X1, X2, X3, X4, X5, X6);
+ Put (Files.Standard_Error.all, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
end Err;
function Format
(T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "")
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
return UTF_8_Lines
is
Buf : Buffer := New_Buffer;
begin
- Put (Buf, T, X1, X2, X3, X4, X5, X6);
+ Put (Buf, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
return Get_UTF_8 (Buf);
end Format;
type Template is new UTF_8;
procedure Put
(S : in out Sink'Class; T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "");
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
-- Prints the template as is, except for the following escape sequences:
-- "\n" is end of line.
-- "\i" indents by the default amount, and "\o" outdents.
procedure Put
(T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "");
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
-- Sends to standard output
procedure Err
(T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "");
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
-- Sends to standard error
function Format
(T : Template;
- X1, X2, X3, X4, X5, X6 : UTF_8_Lines := "")
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
return UTF_8_Lines;
-- Returns a UTF-8-encoded String
-- Analyze_Expression_With_Actions --
-------------------------------------
- -- Start of processing for Analyze_Quantified_Expression
-
procedure Analyze_Expression_With_Actions (N : Node_Id) is
procedure Check_Action_OK (A : Node_Id);
-------------------------------------
procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id) is
+
+ function OK_For_Static (Act : Node_Id) return Boolean;
+ -- True if Act is an action of a declare_expression that is allowed in a
+ -- static declare_expression.
+
+ function All_OK_For_Static return Boolean;
+ -- True if all actions of N are allowed in a static declare_expression.
+
+ function Get_Literal (Expr : Node_Id) return Node_Id;
+ -- Expr is an expression with compile-time-known value. This returns the
+ -- literal node that reprsents that value.
+
+ function OK_For_Static (Act : Node_Id) return Boolean is
+ begin
+ case Nkind (Act) is
+ when N_Object_Declaration =>
+ if Constant_Present (Act)
+ and then Is_Static_Expression (Expression (Act))
+ then
+ return True;
+ end if;
+
+ when N_Object_Renaming_Declaration =>
+ if Statically_Names_Object (Name (Act)) then
+ return True;
+ end if;
+
+ when others =>
+ -- No other declarations, nor even pragmas, are allowed in a
+ -- declare expression, so if we see something else, it must be
+ -- an internally generated expression_with_actions.
+ null;
+ end case;
+
+ return False;
+ end OK_For_Static;
+
+ function All_OK_For_Static return Boolean is
+ Act : Node_Id := First (Actions (N));
+ begin
+ while Present (Act) loop
+ if not OK_For_Static (Act) then
+ return False;
+ end if;
+
+ Next (Act);
+ end loop;
+
+ return True;
+ end All_OK_For_Static;
+
+ function Get_Literal (Expr : Node_Id) return Node_Id is
+ pragma Assert (Compile_Time_Known_Value (Expr));
+ Result : Node_Id;
+ begin
+ case Nkind (Expr) is
+ when N_Has_Entity =>
+ if Ekind (Entity (Expr)) = E_Enumeration_Literal then
+ Result := Expr;
+ else
+ Result := Constant_Value (Entity (Expr));
+ end if;
+ when N_Numeric_Or_String_Literal =>
+ Result := Expr;
+ when others =>
+ raise Program_Error;
+ end case;
+
+ pragma Assert
+ (Nkind (Result) in N_Numeric_Or_String_Literal
+ or else Ekind (Entity (Result)) = E_Enumeration_Literal);
+ return Result;
+ end Get_Literal;
+
+ Loc : constant Source_Ptr := Sloc (N);
+
begin
Set_Etype (N, Typ);
- -- If N has no actions, and its expression has been constant folded,
- -- then rewrite N as just its expression. Note, we can't do this in
- -- the general case of Is_Empty_List (Actions (N)) as this would cause
- -- Expression (N) to be expanded again.
+ if Is_Empty_List (Actions (N)) then
+ pragma Assert (All_OK_For_Static); null;
+ end if;
- if Is_Empty_List (Actions (N))
- and then Compile_Time_Known_Value (Expression (N))
- then
- Rewrite (N, Expression (N));
+ -- If the value of the expression is known at compile time, and all
+ -- of the actions (if any) are suitable, then replace the declare
+ -- expression with its expression. This allows the declare expression
+ -- as a whole to be static if appropriate. See AI12-0368.
+
+ if Compile_Time_Known_Value (Expression (N)) then
+ if Is_Empty_List (Actions (N)) then
+ Rewrite (N, Expression (N));
+ elsif All_OK_For_Static then
+ Rewrite
+ (N, New_Copy_Tree
+ (Get_Literal (Expression (N)), New_Sloc => Loc));
+ end if;
end if;
end Resolve_Expression_With_Actions;
projects / gcc.git / commitdiff