OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2010-10-19  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb, exp_ch4.ads (Expand_Quantified_Expression): New procedure
	* exp_util.adb (Insert_Actions): Include Quantified_Expression.
	* expander.adb: Call Expand_Qualified_Expression.
	* par.adb: New procedure P_Quantified_Expression. Make
	P_Loop_Parameter_Specification global for use in quantified expressions.
	* par-ch3.adb (P_Subtype_Mark_Resync): Allow "some" as an identifier if
	version < Ada2012.
	* par-ch4.adb: New procedure P_Quantified_Expression.
	* par-ch5.adb: P_Loop_Parameter_Specification is now global.
	* scans.adb, scans.ads: Introduce token Some. For now leave as
	unreserved.
	* scn.adb (Scan_Reserved_Identifier): For earlier versions of Ada,
	treat Some as a regular identifier.
	* sem.adb: Call Analyze_Quantified_Expression.
	* sem_ch4.adb, sem_ch4.ads: New procedure Analyze_Quantified_Expression.
	* sem_ch5.adb, sem_ch5.ads: Analyze_Iteration_Scheme is public, for use
	in quantified expressions.
	* sem_res.adb: New procedure Resolve_Qualified_Expression.
	* sinfo.adb, sinfo.ads: New node N_Quantified_Expression
	* snames.ads-tmpl: New name Some.
	* sprint.adb: Output quantified_expression.

2010-10-19  Robert Dewar  <dewar@adacore.com>

	* a-exexda.adb: Minor reformatting
	Minor code reorganization.

From-SVN: r165698
This commit is contained in:
Arnaud Charlet 2010-10-19 14:29:25 +02:00
parent 11c260d7cd
commit a961aa7958
23 changed files with 358 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/ada/ChangeLog
View File

@ -1,3 +1,32 @@
2010-10-19 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb, exp_ch4.ads (Expand_Quantified_Expression): New procedure
* exp_util.adb (Insert_Actions): Include Quantified_Expression.
* expander.adb: Call Expand_Qualified_Expression.
* par.adb: New procedure P_Quantified_Expression. Make
P_Loop_Parameter_Specification global for use in quantified expressions.
* par-ch3.adb (P_Subtype_Mark_Resync): Allow "some" as an identifier if
version < Ada2012.
* par-ch4.adb: New procedure P_Quantified_Expression.
* par-ch5.adb: P_Loop_Parameter_Specification is now global.
* scans.adb, scans.ads: Introduce token Some. For now leave as
unreserved.
* scn.adb (Scan_Reserved_Identifier): For earlier versions of Ada,
treat Some as a regular identifier.
* sem.adb: Call Analyze_Quantified_Expression.
* sem_ch4.adb, sem_ch4.ads: New procedure Analyze_Quantified_Expression.
* sem_ch5.adb, sem_ch5.ads: Analyze_Iteration_Scheme is public, for use
in quantified expressions.
* sem_res.adb: New procedure Resolve_Qualified_Expression.
* sinfo.adb, sinfo.ads: New node N_Quantified_Expression
* snames.ads-tmpl: New name Some.
* sprint.adb: Output quantified_expression.
2010-10-19 Robert Dewar <dewar@adacore.com>
* a-exexda.adb: Minor reformatting
Minor code reorganization.
2010-10-19 Robert Dewar <dewar@adacore.com>
* sem_eval.adb: Minor reformatting.

9
gcc/ada/a-exexda.adb
View File

@ -574,8 +574,9 @@ package body Exception_Data is
-------------------
procedure Append_Number (Number : Integer) is
Val : Integer := Number;
Size : Integer := 1;
Val : Integer;
Size : Integer;
begin
if Number <= 0 then
return;
@ -583,6 +584,8 @@ package body Exception_Data is
-- Compute the number of needed characters
Size := 1;
Val := Number;
while Val > 0 loop
Val := Val / 10;
Size := Size + 1;
@ -606,6 +609,8 @@ package body Exception_Data is
end if;
end Append_Number;
-- Start of processing for Set_Exception_C_Msg
begin
Exception_Propagation.Setup_Exception (Excep, Excep);
Excep.Exception_Raised := False;

85
gcc/ada/exp_ch4.adb
View File

@ -7393,6 +7393,91 @@ package body Exp_Ch4 is
end if;
end Expand_N_Qualified_Expression;
------------------------------------
-- Expand_N_Quantified_Expression --
------------------------------------
procedure Expand_N_Quantified_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Iterator : constant Node_Id := Loop_Parameter_Specification (N);
Cond : constant Node_Id := Condition (N);
Actions : List_Id;
Decl : Node_Id;
Test : Node_Id;
Tnn : Entity_Id;
-- We expand
-- for all X in range => Cond
-- into
-- R := True;
-- for all X in range loop
-- if not Cond then
-- R := False;
-- exit;
-- end if;
-- end loop;
--
-- Conversely, an existentially quantified expression becomes:
--
-- R := False;
-- for all X in range loop
-- if Cond then
-- R := True;
-- exit;
-- end if;
-- end loop;
begin
Actions := New_List;
Tnn := Make_Temporary (Loc, 'T');
Decl := Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc));
Append_To (Actions, Decl);
if All_Present (N) then
Set_Expression (Decl, New_Occurrence_Of (Standard_True, Loc));
Test :=
Make_If_Statement (Loc,
Condition =>
Make_Op_Not (Loc, Relocate_Node (Cond)),
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Tnn, Loc),
Expression => New_Occurrence_Of (Standard_False, Loc)),
Make_Exit_Statement (Loc)));
else
Set_Expression (Decl, New_Occurrence_Of (Standard_False, Loc));
Test :=
Make_If_Statement (Loc,
Condition => Relocate_Node (Cond),
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Tnn, Loc),
Expression => New_Occurrence_Of (Standard_True, Loc)),
Make_Exit_Statement (Loc)));
end if;
Append_To (Actions,
Make_Loop_Statement (Loc,
Iteration_Scheme =>
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification => Iterator),
Statements => New_List (Test),
End_Label => Empty));
Rewrite (N,
Make_Expression_With_Actions (Loc,
Expression => New_Occurrence_Of (Tnn, Loc),
Actions => Actions));
Analyze_And_Resolve (N, Standard_Boolean);
end Expand_N_Quantified_Expression;
---------------------------------
-- Expand_N_Selected_Component --
---------------------------------

1
gcc/ada/exp_ch4.ads
View File

@ -66,6 +66,7 @@ package Exp_Ch4 is
procedure Expand_N_Op_Xor (N : Node_Id);
procedure Expand_N_Or_Else (N : Node_Id);
procedure Expand_N_Qualified_Expression (N : Node_Id);
procedure Expand_N_Quantified_Expression (N : Node_Id);
procedure Expand_N_Selected_Component (N : Node_Id);
procedure Expand_N_Slice (N : Node_Id);
procedure Expand_N_Type_Conversion (N : Node_Id);

1
gcc/ada/exp_util.adb
View File

@ -2877,6 +2877,7 @@ package body Exp_Util is
N_Push_Program_Error_Label |
N_Push_Storage_Error_Label |
N_Qualified_Expression |
N_Quantified_Expression |
N_Range |
N_Range_Constraint |
N_Real_Literal |

3
gcc/ada/expander.adb
View File

@ -364,6 +364,9 @@ package body Expander is
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);

10
gcc/ada/par-ch3.adb
View File

@ -1137,6 +1137,16 @@ package body Ch3 is
Discard_Junk_Node (P_Array_Type_Definition);
return Error;
-- If Some becomes a keyword, the following is needed to make it
-- acceptable in older versions of Ada.
elsif Token = Tok_Some
and then Ada_Version < Ada_2012
then
Scan_Reserved_Identifier (False);
Scan;
return Token_Node;
else
Type_Node := P_Qualified_Simple_Name_Resync;

104
gcc/ada/par-ch4.adb
View File

@ -648,7 +648,7 @@ package body Ch4 is
Error_Msg
("expect identifier in parameter association",
Sloc (Expr_Node));
Scan; -- past arrow.
Scan; -- past arrow
elsif not Comma_Present then
T_Right_Paren;
@ -1214,6 +1214,13 @@ package body Ch4 is
T_Right_Paren;
return Expr_Node;
-- Quantified expression case
elsif Token = Tok_For then
Expr_Node := P_Quantified_Expression;
T_Right_Paren;
return Expr_Node;
-- Note: the mechanism used here of rescanning the initial expression
-- is distinctly unpleasant, but it saves a lot of fiddling in scanning
-- out the discrete choice list.
@ -1415,8 +1422,19 @@ package body Ch4 is
-- that doesn't belong to us!
if Token in Token_Class_Eterm then
Error_Msg_AP ("expecting expression or component association");
exit;
-- If Some becomes a keyword, the following is needed to make it
-- acceptable in older versions of Ada.
if Token = Tok_Some
and then Ada_Version < Ada_2012
then
Scan_Reserved_Identifier (False);
else
Error_Msg_AP
("expecting expression or component association");
exit;
end if;
end if;
-- Deal with misused box
@ -1616,15 +1634,20 @@ package body Ch4 is
end P_Expression;
-- This function is identical to the normal P_Expression, except that it
-- also permits the appearence of a case of conditional expression without
-- the usual surrounding parentheses.
-- also permits the appearance of a case, conditional, or quantified
-- expression without the usual surrounding parentheses.
function P_Expression_If_OK return Node_Id is
begin
if Token = Tok_Case then
return P_Case_Expression;
elsif Token = Tok_If then
return P_Conditional_Expression;
elsif Token = Tok_For then
return P_Quantified_Expression;
else
return P_Expression;
end if;
@ -1720,14 +1743,20 @@ package body Ch4 is
end if;
end P_Expression_Or_Range_Attribute;
-- Version that allows a non-parenthesized case or conditional expression
-- Version that allows a non-parenthesized case, conditional, or quantified
-- expression
function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
begin
if Token = Tok_Case then
return P_Case_Expression;
elsif Token = Tok_If then
return P_Conditional_Expression;
elsif Token = Tok_For then
return P_Quantified_Expression;
else
return P_Expression_Or_Range_Attribute;
end if;
@ -2285,7 +2314,7 @@ package body Ch4 is
-- NUMERIC_LITERAL | null
-- | STRING_LITERAL | AGGREGATE
-- | NAME | QUALIFIED_EXPRESSION
-- | ALLOCATOR | (EXPRESSION)
-- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
-- Error recovery: can raise Error_Resync
@ -2436,6 +2465,25 @@ package body Ch4 is
return P_Identifier;
end if;
-- For [all | some] indicates a quantified expression
when Tok_For =>
if Token_Is_At_Start_Of_Line then
Error_Msg_AP ("misplaced loop");
return Error;
elsif Ada_Version >= Ada_2012 then
Error_Msg_SC ("quantified expression must be parenthesized");
return P_Quantified_Expression;
else
-- Otherwise treat as misused identifier
return P_Identifier;
end if;
-- Anything else is illegal as the first token of a primary, but
-- we test for a reserved identifier so that it is treated nicely
@ -2457,6 +2505,48 @@ package body Ch4 is
end loop;
end P_Primary;
-------------------------------
-- 4.4 Quantified_Expression --
-------------------------------
-- QUANTIFIED_EXPRESSION ::=
-- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
-- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
function P_Quantified_Expression return Node_Id is
Node1 : Node_Id;
begin
Scan; -- past FOR
Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
if Token = Tok_All then
Set_All_Present (Node1);
-- We treat Some as a non-reserved keyword, so it appears to
-- the scanner as an identifier. If Some is made into a reserved
-- work, the check below is against Tok_Some.
elsif Token /= Tok_Identifier
or else Chars (Token_Node) /= Name_Some
then
Error_Msg_AP ("missing quantifier");
raise Error_Resync;
end if;
Scan;
Set_Loop_Parameter_Specification (Node1, P_Loop_Parameter_Specification);
if Token = Tok_Arrow then
Scan;
Set_Condition (Node1, P_Expression);
return Node1;
else
Error_Msg_AP ("missing arrow");
raise Error_Resync;
end if;
end P_Quantified_Expression;
---------------------------
-- 4.5 Logical Operator --
---------------------------

1
gcc/ada/par-ch5.adb
View File

@ -38,7 +38,6 @@ package body Ch5 is
function P_Goto_Statement return Node_Id;
function P_If_Statement return Node_Id;
function P_Label return Node_Id;
function P_Loop_Parameter_Specification return Node_Id;
function P_Null_Statement return Node_Id;
function P_Assignment_Statement (LHS : Node_Id) return Node_Id;

7
gcc/ada/par.adb
View File

@ -703,6 +703,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id;
-- This routine scans out a qualified expression when the caller has
-- already scanned out the name and apostrophe of the construct.
function P_Quantified_Expression return Node_Id;
-- This routine scans out a quantified expression when the caller has
-- already scanned out the keyword "for" of the construct.
end Ch4;
-------------
@ -713,6 +717,9 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
function P_Condition return Node_Id;
-- Scan out and return a condition
function P_Loop_Parameter_Specification return Node_Id;
-- Used in loop constructs and quantified expressions.
function P_Statement_Name (Name_Node : Node_Id) return Node_Id;
-- Given a node representing a name (which is a call), converts it
-- to the syntactically corresponding procedure call statement.

9
gcc/ada/scans.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -118,6 +118,13 @@ package body Scans is
Set_Reserved (Name_Reverse, Tok_Reverse);
Set_Reserved (Name_Select, Tok_Select);
Set_Reserved (Name_Separate, Tok_Separate);
-- We choose to make Some into a non-reserved word, so it is handled
-- like a regular identifier in most contexts. Uncomment the following
-- line if a pedantic Ada2012 mode is required.
-- Set_Reserved (Name_Some, Tok_Some);
Set_Reserved (Name_Subtype, Tok_Subtype);
Set_Reserved (Name_Tagged, Tok_Tagged);
Set_Reserved (Name_Task, Tok_Task);

1
gcc/ada/scans.ads
View File

@ -130,6 +130,7 @@ package Scans is
Tok_Record, -- RECORD Eterm, Sterm
Tok_Renames, -- RENAMES Eterm, Sterm
Tok_Reverse, -- REVERSE Eterm, Sterm
Tok_Some, -- SOME Eterm, Sterm
Tok_Tagged, -- TAGGED Eterm, Sterm
Tok_Then, -- THEN Eterm, Sterm

17
gcc/ada/scn.adb
View File

@ -472,9 +472,20 @@ package body Scn is
Token_Name := Name_Find;
if not Used_As_Identifier (Token) or else Force_Msg then
Error_Msg_Name_1 := Token_Name;
Error_Msg_SC ("reserved word* cannot be used as identifier!");
Used_As_Identifier (Token) := True;
-- If "some" is made into a reseverd work in Ada2012, the following
-- check will make it into a regular identifer in earlier versions
-- of the language.
if Token = Tok_Some
and then Ada_Version < Ada_2012
then
null;
else
Error_Msg_Name_1 := Token_Name;
Error_Msg_SC ("reserved word* cannot be used as identifier!");
Used_As_Identifier (Token) := True;
end if;
end if;
Token := Tok_Identifier;

3
gcc/ada/sem.adb
View File

@ -470,6 +470,9 @@ package body Sem is
when N_Qualified_Expression =>
Analyze_Qualified_Expression (N);
when N_Quantified_Expression =>
Analyze_Quantified_Expression (N);
when N_Raise_Statement =>
Analyze_Raise_Statement (N);

27
gcc/ada/sem_ch4.adb
View File

@ -46,6 +46,7 @@ with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch5; use Sem_Ch5;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Disp; use Sem_Disp;
@ -3176,6 +3177,32 @@ package body Sem_Ch4 is
Set_Etype (N, T);
end Analyze_Qualified_Expression;
-----------------------------------
-- Analyze_Quantified_Expression --
-----------------------------------
procedure Analyze_Quantified_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Ent : constant Entity_Id :=
New_Internal_Entity
(E_Loop, Current_Scope, Sloc (N), 'L');
Iterator : Node_Id;
begin
Set_Etype (Ent, Standard_Void_Type);
Set_Parent (Ent, N);
Iterator :=
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification => Loop_Parameter_Specification (N));
Push_Scope (Ent);
Analyze_Iteration_Scheme (Iterator);
Analyze (Condition (N));
End_Scope;
Set_Etype (N, Standard_Boolean);
end Analyze_Quantified_Expression;
-------------------
-- Analyze_Range --
-------------------

1
gcc/ada/sem_ch4.ads
View File

@ -42,6 +42,7 @@ package Sem_Ch4 is
procedure Analyze_Negation (N : Node_Id);
procedure Analyze_Null (N : Node_Id);
procedure Analyze_Qualified_Expression (N : Node_Id);
procedure Analyze_Quantified_Expression (N : Node_Id);
procedure Analyze_Range (N : Node_Id);
procedure Analyze_Reference (N : Node_Id);
procedure Analyze_Selected_Component (N : Node_Id);

6
gcc/ada/sem_ch5.adb
View File

@ -70,12 +70,6 @@ package body Sem_Ch5 is
-- messages. This variable is recursively saved on entry to processing the
-- construct, and restored on exit.
-----------------------
-- Local Subprograms --
-----------------------
procedure Analyze_Iteration_Scheme (N : Node_Id);
------------------------
-- Analyze_Assignment --
------------------------

3
gcc/ada/sem_ch5.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -34,6 +34,7 @@ package Sem_Ch5 is
procedure Analyze_Goto_Statement (N : Node_Id);
procedure Analyze_If_Statement (N : Node_Id);
procedure Analyze_Implicit_Label_Declaration (N : Node_Id);
procedure Analyze_Iteration_Scheme (N : Node_Id);
procedure Analyze_Label (N : Node_Id);
procedure Analyze_Loop_Statement (N : Node_Id);
procedure Analyze_Null_Statement (N : Node_Id);

16
gcc/ada/sem_res.adb
View File

@ -192,6 +192,7 @@ package body Sem_Res is
procedure Resolve_Op_Expon (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Op_Not (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Qualified_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Range (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Real_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Reference (N : Node_Id; Typ : Entity_Id);
@ -2698,6 +2699,9 @@ package body Sem_Res is
when N_Qualified_Expression
=> Resolve_Qualified_Expression (N, Ctx_Type);
when N_Quantified_Expression
=> Resolve_Quantified_Expression (N, Ctx_Type);
when N_Raise_xxx_Error
=> Set_Etype (N, Ctx_Type);
@ -7767,6 +7771,18 @@ package body Sem_Res is
Eval_Qualified_Expression (N);
end Resolve_Qualified_Expression;
-----------------------------------
-- Resolve_Quantified_Expression --
-----------------------------------
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
begin
-- The loop structure is already resolved during its analysis, only the
-- resolution of the condition needs to be done.
Resolve (Condition (N), Typ);
end Resolve_Quantified_Expression;
-------------------
-- Resolve_Range --
-------------------

10
gcc/ada/sinfo.adb
View File

@ -224,6 +224,7 @@ package body Sinfo is
pragma Assert (False
or else NT (N).Nkind = N_Access_Definition
or else NT (N).Nkind = N_Access_To_Object_Definition
or else NT (N).Nkind = N_Quantified_Expression
or else NT (N).Nkind = N_Use_Type_Clause);
return Flag15 (N);
end All_Present;
@ -512,6 +513,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Exit_Statement
or else NT (N).Nkind = N_If_Statement
or else NT (N).Nkind = N_Iteration_Scheme
or else NT (N).Nkind = N_Quantified_Expression
or else NT (N).Nkind = N_Raise_Constraint_Error
or else NT (N).Nkind = N_Raise_Program_Error
or else NT (N).Nkind = N_Raise_Storage_Error
@ -1988,7 +1990,8 @@ package body Sinfo is
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Iteration_Scheme);
or else NT (N).Nkind = N_Iteration_Scheme
or else NT (N).Nkind = N_Quantified_Expression);
return Node4 (N);
end Loop_Parameter_Specification;
@ -3219,6 +3222,7 @@ package body Sinfo is
pragma Assert (False
or else NT (N).Nkind = N_Access_Definition
or else NT (N).Nkind = N_Access_To_Object_Definition
or else NT (N).Nkind = N_Quantified_Expression
or else NT (N).Nkind = N_Use_Type_Clause);
Set_Flag15 (N, Val);
end Set_All_Present;
@ -3507,6 +3511,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Exit_Statement
or else NT (N).Nkind = N_If_Statement
or else NT (N).Nkind = N_Iteration_Scheme
or else NT (N).Nkind = N_Quantified_Expression
or else NT (N).Nkind = N_Raise_Constraint_Error
or else NT (N).Nkind = N_Raise_Program_Error
or else NT (N).Nkind = N_Raise_Storage_Error
@ -4975,7 +4980,8 @@ package body Sinfo is
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Iteration_Scheme);
or else NT (N).Nkind = N_Iteration_Scheme
or else NT (N).Nkind = N_Quantified_Expression);
Set_Node4_With_Parent (N, Val);
end Set_Loop_Parameter_Specification;

24
gcc/ada/sinfo.ads
View File

@ -3817,6 +3817,22 @@ package Sinfo is
-- point operands if the Treat_Fixed_As_Integer flag is set and will
-- thus treat these nodes in identical manner, ignoring small values.
---------------------------------
-- 4.5.9 Quantified Expression --
---------------------------------
-- QUANTIFIED_EXPRESSION ::=
-- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
-- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
--
-- QUANTIFIER ::= all | some
-- N_Quantified_Expression
-- Sloc points to token for
-- Loop_Parameter_Specification (Node4)
-- Condition (Node1)
-- All_Present (Flag15)
--------------------------
-- 4.6 Type Conversion --
--------------------------
@ -7447,6 +7463,7 @@ package Sinfo is
N_Null,
N_Procedure_Call_Statement,
N_Qualified_Expression,
N_Quantified_Expression,
-- N_Raise_xxx_Error, N_Subexpr, N_Has_Etype
@ -10473,6 +10490,13 @@ package Sinfo is
4 => True, -- Subtype_Mark (Node4)
5 => False), -- Etype (Node5-Sem)
N_Quantified_Expression =>
(1 => True, -- Condition (Node1)
2 => False, -- unused
3 => False, -- unused
4 => True, -- Loop_Parameter_Specification (Node4)
5 => False), -- Etype (Node5-Sem)
N_Allocator =>
(1 => False, -- Storage_Pool (Node1-Sem)
2 => False, -- Procedure_To_Call (Node2-Sem)

1
gcc/ada/snames.ads-tmpl
View File

@ -985,6 +985,7 @@ package Snames is
Name_Reverse : constant Name_Id := N + $;
Name_Select : constant Name_Id := N + $;
Name_Separate : constant Name_Id := N + $;
Name_Some : constant Name_Id := N + $;
Name_Subtype : constant Name_Id := N + $;
Name_Task : constant Name_Id := N + $;
Name_Terminate : constant Name_Id := N + $;

13
gcc/ada/sprint.adb
View File

@ -2626,6 +2626,19 @@ package body Sprint is
Write_Char (')');
end if;
when N_Quantified_Expression =>
Write_Str (" for");
if All_Present (Node) then
Write_Str (" all ");
else
Write_Str (" some ");
end if;
Sprint_Node (Loop_Parameter_Specification (Node));
Write_Str (" => ");
Sprint_Node (Condition (Node));
when N_Raise_Constraint_Error =>
-- This node can be used either as a subexpression or as a