Patchwork [Ada] Implementation of quantified expressions

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 19, 2010, 12:30 p.m.
Message ID <20101019123018.GA3187@adacore.com>
Download mbox | patch
Permalink /patch/68328/
State New
Headers show

Comments

Arnaud Charlet - Oct. 19, 2010, 12:30 p.m.
This patch implements part of the Ada2012 quantified expressions machinery.
Iterator forms over arrays are supported.
Execution of the following in Ada2012 mode must yield:

YES
FALSE
TRUE
TRUE
TRUE

--
with Text_IO; use Text_IO;
procedure Proc is
   type Ar is array (1..10) of integer;
   Thing : Ar := (others => 0);

   function Change (X : integer) return Boolean is
   begin
      if Thing (X) >= 0 then
         Thing (X) := -1;
         return True;
      else
         return False;
      end if;
   end Change;
   
begin
   if (for all I in thing'range => Thing (I) = 0) then
      Put_Line ("YES");
   end if;

   Thing (5 ) := -111;
   Put_Line (Boolean'Image (for all J in thing'range => Thing (J) > 0));

   Put_Line (Boolean'Image (for some J in thing'range => Thing (J) < 0));

   while (for some I in thing'range => Change (I)) loop null; end loop;

   Put_Line (Boolean'Image (for all K in thing'range => Thing (K) < 0));

   Thing := (0,1,2,3,4,5,6,7,8,9);
   Put_Line (Boolean'Image (for all I in Thing'first.. Thing'last - 1=>
      Thing (I) < THing (I+1)));
end;

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

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.

Patch

Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb	(revision 165687)
+++ sem_ch5.adb	(working copy)
@@ -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 --
    ------------------------
Index: sem_ch5.ads
===================================================================
--- sem_ch5.ads	(revision 165687)
+++ sem_ch5.ads	(working copy)
@@ -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);
Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 165694)
+++ exp_util.adb	(working copy)
@@ -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                           |
Index: sinfo.adb
===================================================================
--- sinfo.adb	(revision 165687)
+++ sinfo.adb	(working copy)
@@ -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;
 
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 165687)
+++ sinfo.ads	(working copy)
@@ -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)
Index: sem.adb
===================================================================
--- sem.adb	(revision 165687)
+++ sem.adb	(working copy)
@@ -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);
 
Index: par-ch4.adb
===================================================================
--- par-ch4.adb	(revision 165692)
+++ par-ch4.adb	(working copy)
@@ -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 --
    ---------------------------
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 165694)
+++ sem_res.adb	(working copy)
@@ -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 --
    -------------------
Index: expander.adb
===================================================================
--- expander.adb	(revision 165687)
+++ expander.adb	(working copy)
@@ -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);
 
Index: scans.adb
===================================================================
--- scans.adb	(revision 165687)
+++ scans.adb	(working copy)
@@ -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);
Index: scans.ads
===================================================================
--- scans.ads	(revision 165687)
+++ scans.ads	(working copy)
@@ -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
 
Index: par.adb
===================================================================
--- par.adb	(revision 165687)
+++ par.adb	(working copy)
@@ -703,6 +703,10 @@  function Par (Configuration_Pragmas : Bo
       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 : Bo
       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.
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 165696)
+++ exp_ch4.adb	(working copy)
@@ -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 --
    ---------------------------------
Index: exp_ch4.ads
===================================================================
--- exp_ch4.ads	(revision 165687)
+++ exp_ch4.ads	(working copy)
@@ -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);
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 165687)
+++ sem_ch4.adb	(working copy)
@@ -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 --
    -------------------
Index: sem_ch4.ads
===================================================================
--- sem_ch4.ads	(revision 165687)
+++ sem_ch4.ads	(working copy)
@@ -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);
Index: scn.adb
===================================================================
--- scn.adb	(revision 165687)
+++ scn.adb	(working copy)
@@ -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;
Index: sprint.adb
===================================================================
--- sprint.adb	(revision 165687)
+++ sprint.adb	(working copy)
@@ -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
Index: par-ch3.adb
===================================================================
--- par-ch3.adb	(revision 165687)
+++ par-ch3.adb	(working copy)
@@ -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;
 
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 165694)
+++ snames.ads-tmpl	(working copy)
@@ -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 + $;
Index: par-ch5.adb
===================================================================
--- par-ch5.adb	(revision 165687)
+++ par-ch5.adb	(working copy)
@@ -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;