From patchwork Thu Jun 17 15:54:51 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56066 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 67BC0B7D83 for ; Fri, 18 Jun 2010 01:54:47 +1000 (EST) Received: (qmail 15939 invoked by alias); 17 Jun 2010 15:54:45 -0000 Received: (qmail 15925 invoked by uid 22791); 17 Jun 2010 15:54:42 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_FILL_THIS_FORM_SHORT, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 17 Jun 2010 15:54:36 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id BAAB2CB021D; Thu, 17 Jun 2010 17:54:41 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Q8UbME8Gs2xH; Thu, 17 Jun 2010 17:54:41 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id A4F8FCB020E; Thu, 17 Jun 2010 17:54:41 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id B0A1ED9A01; Thu, 17 Jun 2010 17:54:51 +0200 (CEST) Date: Thu, 17 Jun 2010 17:54:51 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar , Eric Botcazou Subject: [Ada] Implement new Expression_With_Actions node Message-ID: <20100617155451.GA26562@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch is the front end work for implementing a new node type Expression_With_Actions. This is currently used if the debug flag -gnatd.X is set and a short circuit form has right hand operand actions. The sprint syntax is do action; action ... in expression end. This test program: procedure ExprActions (A, B, C : Natural; M, N : String) is begin if (A = 23 and then M (1 .. A) = N (1 .. B)) or else M (A .. B) = M (B .. C) then null; end if; end ExprActions; Now generates the following -gnatG output if -gnatd.X is set: Source recreated from tree for Expractions (body) procedure expractions (a : natural; b : natural; c : natural; m : string; n : string) is subtype expractions__S2b is string (n'first(1) .. n'last(1)); subtype expractions__S1b is string (m'first(1) .. m'last(1)); begin if (a = 23 and then do [constraint_error when a >= 1 and then (1 < m'first(1) or else integer(a) > m'last( 1)) "range check failed"] reference expractions__T4b[constraint_error when b >= 1 and then (1 < n'first(1) or else integer(b) > n'last( 1)) "range check failed"] reference expractions__T6b in m (1 .. a) = n (1 .. b) end ) or else do [constraint_error when b >= a and then (integer(a) < m'first(1) or else integer(b) > m'last(1)) "range check failed"] reference expractions__T8b[constraint_error when c >= b and then (integer(b) < m'first(1) or else integer(c) > m'last(1)) "range check failed"] reference expractions__T10b in m (a .. b) = m (b .. c) end then null; end if; return; end expractions; This patch does not include the required gigi adjustments to process this new node (which is why it is under a debug flag for now), so with only this patch, the above test compiled with -gnatd.X will blowup in gigi. Eric will commit the corresponding support for N_Expression_With_Actions in gigi later. The motivation behind this is to avoid the problem with the old style expansion of short circuit forms with right operand actions. The old style introduced a boolean temporary which caused problems with coverage analysis. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-17 Robert Dewar * debug.adb: New debug flag -gnatd.X to use Expression_With_Actions node when expanding short circuit form with actions present for right opnd. * exp_ch4.adb: Minor reformatting (Expand_Short_Circuit_Operator): Use new Expression_With_Actions node if right opeand has actions present, and debug flag -gnatd.X is set. * exp_util.adb (Insert_Actions): Handle case of Expression_With_Actions node. * nlists.adb (Prepend_List): New procedure (Prepend_List_To): New procedure * nlists.ads (Prepend_List): New procedure (Prepend_List_To): New procedure * sem.adb: Add processing for Expression_With_Actions * sem_ch4.adb (Analyze_Expression_With_Actions): New procedure * sem_ch4.ads (Analyze_Expression_With_Actions): New procedure * sem_res.adb: Add processing for Expression_With_Actions. * sem_scil.adb: Add processing for Expression_With_Actions * sinfo.ads, sinfo.adb (N_Expression_With_Actions): New node. * sprint.ads, sprint.adb: Add processing for Expression_With_Actions Index: exp_util.adb =================================================================== --- exp_util.adb (revision 160923) +++ exp_util.adb (working copy) @@ -2417,6 +2417,13 @@ package body Exp_Util is end if; end; + -- Case of appearing within an Expressions_With_Actions node. We + -- prepend the actions to the list of actions already there. + + when N_Expression_With_Actions => + Prepend_List (Ins_Actions, Actions (P)); + return; + -- Case of appearing in the condition of a while expression or -- elsif. We insert the actions into the Condition_Actions field. -- They will be moved further out when the while loop or elsif Index: nlists.adb =================================================================== --- nlists.adb (revision 160923) +++ nlists.adb (working copy) @@ -1055,6 +1055,77 @@ package body Nlists is Set_List_Link (Node, To); end Prepend; + ------------------ + -- Prepend_List -- + ------------------ + + procedure Prepend_List (List : List_Id; To : List_Id) is + + procedure Prepend_List_Debug; + pragma Inline (Prepend_List_Debug); + -- Output debug information if Debug_Flag_N set + + ------------------------ + -- Prepend_List_Debug -- + ------------------------ + + procedure Prepend_List_Debug is + begin + if Debug_Flag_N then + Write_Str ("Prepend list "); + Write_Int (Int (List)); + Write_Str (" to list "); + Write_Int (Int (To)); + Write_Eol; + end if; + end Prepend_List_Debug; + + -- Start of processing for Prepend_List + + begin + if Is_Empty_List (List) then + return; + + else + declare + F : constant Node_Id := First (To); + L : constant Node_Id := Last (List); + N : Node_Id; + + begin + pragma Debug (Prepend_List_Debug); + + N := L; + loop + Set_List_Link (N, To); + N := Prev (N); + exit when No (N); + end loop; + + if No (F) then + Set_Last (To, L); + else + Set_Next (L, F); + end if; + + Set_Prev (F, L); + Set_First (To, First (List)); + + Set_First (List, Empty); + Set_Last (List, Empty); + end; + end if; + end Prepend_List; + + --------------------- + -- Prepend_List_To -- + --------------------- + + procedure Prepend_List_To (To : List_Id; List : List_Id) is + begin + Prepend_List (List, To); + end Prepend_List_To; + ---------------- -- Prepend_To -- ---------------- Index: nlists.ads =================================================================== --- nlists.ads (revision 160923) +++ nlists.ads (working copy) @@ -259,6 +259,14 @@ package Nlists is pragma Inline (Prepend_To); -- Like Prepend, but arguments are the other way round + procedure Prepend_List (List : List_Id; To : List_Id); + -- Prepends node list List to the start of node list To. On return, + -- List is reset to be empty. + + procedure Prepend_List_To (To : List_Id; List : List_Id); + pragma Inline (Prepend_List_To); + -- Like Prepend_List, but arguments are the other way round + procedure Remove (Node : Node_Id); -- Removes Node, which must be a node that is a member of a node list, -- from this node list. The contents of Node are not otherwise affected. Index: sinfo.adb =================================================================== --- sinfo.adb (revision 160923) +++ sinfo.adb (working copy) @@ -147,6 +147,7 @@ package body Sinfo is pragma Assert (False or else NT (N).Nkind = N_And_Then or else NT (N).Nkind = N_Compilation_Unit_Aux + or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Freeze_Entity or else NT (N).Nkind = N_Or_Else); return List1 (N); @@ -1178,6 +1179,7 @@ package body Sinfo is or else NT (N).Nkind = N_Discriminant_Association or else NT (N).Nkind = N_Discriminant_Specification or else NT (N).Nkind = N_Exception_Declaration + or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Free_Statement or else NT (N).Nkind = N_Mod_Clause or else NT (N).Nkind = N_Modular_Type_Definition @@ -3058,6 +3060,7 @@ package body Sinfo is pragma Assert (False or else NT (N).Nkind = N_And_Then or else NT (N).Nkind = N_Compilation_Unit_Aux + or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Freeze_Entity or else NT (N).Nkind = N_Or_Else); Set_List1_With_Parent (N, Val); @@ -4080,6 +4083,7 @@ package body Sinfo is or else NT (N).Nkind = N_Discriminant_Association or else NT (N).Nkind = N_Discriminant_Specification or else NT (N).Nkind = N_Exception_Declaration + or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Free_Statement or else NT (N).Nkind = N_Mod_Clause or else NT (N).Nkind = N_Modular_Type_Definition Index: sinfo.ads =================================================================== --- sinfo.ads (revision 160923) +++ sinfo.ads (working copy) @@ -6611,6 +6611,38 @@ package Sinfo is -- Has_Private_View (Flag11-Sem) set in generic units. -- plus fields for expression + ----------------------------- + -- Expression with Actions -- + ----------------------------- + + -- This node is created by the analyzer/expander to handle some + -- expansion cases, notably short circuit forms where there are + -- actions associated with the right hand operand. + + -- The N_Expression_With_Actions node represents an expression with + -- an associated set of actions (which are executable statements). + -- The required semantics is that the set of actions is executed in + -- the order in which it appears just before the expression is + -- evaluated (and these actions must only be executed if the value + -- of the expression is evaluated). The node is considered to be + -- a subexpression, whose value is the value of the Expression after + -- executing all the actions. + + -- Sprint syntax: do + -- action; + -- action; + -- ... + -- action; + -- in expression end + + -- N_Expression_With_Actions + -- Actions (List1) + -- Expression (Node3) + -- plus fields for expression + + -- Note: the actions list is always non-null, since we would + -- never have created this node if there weren't some actions. + -------------------- -- Free Statement -- -------------------- @@ -7195,6 +7227,7 @@ package Sinfo is N_Conditional_Expression, N_Explicit_Dereference, + N_Expression_With_Actions, N_Function_Call, N_Indexed_Component, N_Integer_Literal, @@ -10984,6 +11017,13 @@ package Sinfo is 4 => False, -- Entity (Node4-Sem) 5 => False), -- Etype (Node5-Sem) + N_Expression_With_Actions => + (1 => True, -- Actions (List1) + 2 => False, -- unused + 3 => True, -- Expression (Node3) + 4 => False, -- unused + 5 => False), -- unused + N_Free_Statement => (1 => False, -- Storage_Pool (Node1-Sem) 2 => False, -- Procedure_To_Call (Node2-Sem) Index: sem_scil.adb =================================================================== --- sem_scil.adb (revision 160923) +++ sem_scil.adb (working copy) @@ -544,6 +544,7 @@ package body Sem_SCIL is N_Exception_Handler | N_Expanded_Name | N_Explicit_Dereference | + N_Expression_With_Actions | N_Extension_Aggregate | N_Floating_Point_Definition | N_Formal_Decimal_Fixed_Point_Definition | Index: debug.adb =================================================================== --- debug.adb (revision 160923) +++ debug.adb (working copy) @@ -141,7 +141,7 @@ package body Debug is -- d.U -- d.V -- d.W Print out debugging information for Walk_Library_Items - -- d.X + -- d.X Use Expression_With_Actions for short-circuited forms -- d.Y -- d.Z @@ -579,6 +579,13 @@ package body Debug is -- the order in which units are walked. This is primarily for SofCheck -- Inspector. + -- d.X By default, the compiler uses an elaborate rewriting framework for + -- short-circuited forms where the right hand condition generates + -- actions to be inserted. Use of this switch causes the compiler to + -- use the much simpler Expression_With_Actions node for this purpose. + -- It is a debug flag to aid transitional implementation in gigi and + -- the back end. As soon as that works fine, we will remove this flag. + -- d1 Error messages have node numbers where possible. Normally error -- messages have only source locations. This option is useful when -- debugging errors caused by expanded code, where the source location Index: sem.adb =================================================================== --- sem.adb (revision 160925) +++ sem.adb (working copy) @@ -221,6 +221,9 @@ package body Sem is when N_Explicit_Dereference => Analyze_Explicit_Dereference (N); + when N_Expression_With_Actions => + Analyze_Expression_With_Actions (N); + when N_Extended_Return_Statement => Analyze_Extended_Return_Statement (N); @@ -1709,7 +1712,7 @@ package body Sem is if Nkind (Unit (Withed_Unit)) = N_Package_Body and then Is_Generic_Instance - (Defining_Entity (Unit (Library_Unit (Withed_Unit)))) + (Defining_Entity (Unit (Library_Unit (Withed_Unit)))) then Do_Withed_Unit (Library_Unit (Withed_Unit)); end if; Index: sem_res.adb =================================================================== --- sem_res.adb (revision 160923) +++ sem_res.adb (working copy) @@ -163,9 +163,10 @@ package body Sem_Res is procedure Resolve_Character_Literal (N : Node_Id; Typ : Entity_Id); procedure Resolve_Comparison_Op (N : Node_Id; Typ : Entity_Id); procedure Resolve_Conditional_Expression (N : Node_Id; Typ : Entity_Id); + procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id); procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id); procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id); - procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id); + procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id); procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id); procedure Resolve_Integer_Literal (N : Node_Id; Typ : Entity_Id); procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id); @@ -1842,6 +1843,7 @@ package body Sem_Res is -- Check that Typ is a remote access-to-subprogram type if Is_Remote_Access_To_Subprogram_Type (Typ) then + -- Prefix (N) must statically denote a remote subprogram -- declared in a package specification. @@ -2542,12 +2544,15 @@ package body Sem_Res is when N_Expanded_Name => Resolve_Entity_Name (N, Ctx_Type); - when N_Extension_Aggregate - => Resolve_Extension_Aggregate (N, Ctx_Type); - when N_Explicit_Dereference => Resolve_Explicit_Dereference (N, Ctx_Type); + when N_Expression_With_Actions + => Resolve_Expression_With_Actions (N, Ctx_Type); + + when N_Extension_Aggregate + => Resolve_Extension_Aggregate (N, Ctx_Type); + when N_Function_Call => Resolve_Call (N, Ctx_Type); @@ -6494,6 +6499,15 @@ package body Sem_Res is end Resolve_Explicit_Dereference; + ------------------------------------- + -- Resolve_Expression_With_Actions -- + ------------------------------------- + + procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id) is + begin + Set_Etype (N, Typ); + end Resolve_Expression_With_Actions; + ------------------------------- -- Resolve_Indexed_Component -- ------------------------------- Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 160923) +++ exp_ch4.adb (working copy) @@ -323,10 +323,8 @@ package body Exp_Ch4 is if Nkind (Op1) = N_Op_Not then if Kind = N_Op_And then Proc_Name := RTE (RE_Vector_Nor); - elsif Kind = N_Op_Or then Proc_Name := RTE (RE_Vector_Nand); - else Proc_Name := RTE (RE_Vector_Xor); end if; @@ -334,14 +332,11 @@ package body Exp_Ch4 is else if Kind = N_Op_And then Proc_Name := RTE (RE_Vector_And); - elsif Kind = N_Op_Or then Proc_Name := RTE (RE_Vector_Or); - elsif Nkind (Op2) = N_Op_Not then Proc_Name := RTE (RE_Vector_Nxor); Arg2 := Right_Opnd (Op2); - else Proc_Name := RTE (RE_Vector_Xor); end if; @@ -352,15 +347,15 @@ package body Exp_Ch4 is Name => New_Occurrence_Of (Proc_Name, Loc), Parameter_Associations => New_List ( Target, - Make_Attribute_Reference (Loc, - Prefix => Arg1, - Attribute_Name => Name_Address), - Make_Attribute_Reference (Loc, - Prefix => Arg2, - Attribute_Name => Name_Address), - Make_Attribute_Reference (Loc, - Prefix => Op1, - Attribute_Name => Name_Length))); + Make_Attribute_Reference (Loc, + Prefix => Arg1, + Attribute_Name => Name_Address), + Make_Attribute_Reference (Loc, + Prefix => Arg2, + Attribute_Name => Name_Address), + Make_Attribute_Reference (Loc, + Prefix => Op1, + Attribute_Name => Name_Length))); end if; Rewrite (N, Call_Node); @@ -8718,8 +8713,9 @@ package body Exp_Ch4 is -- Expand_Short_Circuit_Operator -- ----------------------------------- - -- Expand into conditional expression if Actions present, and also deal - -- with optimizing case of arguments being True or False. + -- Deal with special expansion if actions are present for the right operand + -- and deal with optimizing case of arguments being True or False. We also + -- deal with the special case of non-standard boolean values. procedure Expand_Short_Circuit_Operator (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); @@ -8727,6 +8723,7 @@ package body Exp_Ch4 is Kind : constant Node_Kind := Nkind (N); Left : constant Node_Id := Left_Opnd (N); Right : constant Node_Id := Right_Opnd (N); + LocR : constant Source_Ptr := Sloc (Right); Actlist : List_Id; Shortcut_Value : constant Boolean := Nkind (N) = N_Or_Else; @@ -8800,63 +8797,88 @@ package body Exp_Ch4 is return; end if; - -- If Actions are present, we expand - - -- left AND THEN right - - -- into + -- If Actions are present for the right operand, we have to do some + -- special processing. We can't just let these actions filter back into + -- code preceding the short circuit (which is what would have happened + -- if we had not trapped them in the short-circuit form), since they + -- must only be executed if the right operand of the short circuit is + -- executed and not otherwise. - -- C : Boolean := False; - -- IF left THEN - -- Actions; - -- IF right THEN - -- C := True; - -- END IF; - -- END IF; - - -- and finally rewrite the operator into a reference to C. Similarly - -- for left OR ELSE right, with negated values. Note that this rewriting - -- preserves two invariants that traces-based coverage analysis depends - -- upon: - - -- - there is exactly one conditional jump for each operand; - - -- - for each possible values of the expression, there is exactly - -- one location in the generated code that is branched to - -- (the inner assignment in one case, the point just past the - -- outer END IF; in the other case). + -- the temporary variable C. if Present (Actions (N)) then Actlist := Actions (N); - Op_Var := Make_Temporary (Loc, 'C', Related_Node => N); + -- The old approach is to expand: - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => - Op_Var, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => - New_Occurrence_Of (Shortcut_Ent, Loc))); - - Append_To (Actlist, - Make_Implicit_If_Statement (Right, - Condition => Make_Test_Expr (Right), - Then_Statements => New_List ( - Make_Assignment_Statement (Sloc (Right), - Name => - New_Occurrence_Of (Op_Var, Sloc (Right)), - Expression => - New_Occurrence_Of - (Boolean_Literals (not Shortcut_Value), Sloc (Right)))))); + -- left AND THEN right - Insert_Action (N, - Make_Implicit_If_Statement (Left, - Condition => Make_Test_Expr (Left), - Then_Statements => Actlist)); + -- into - Rewrite (N, New_Occurrence_Of (Op_Var, Loc)); + -- C : Boolean := False; + -- IF left THEN + -- Actions; + -- IF right THEN + -- C := True; + -- END IF; + -- END IF; + + -- and finally rewrite the operator into a reference to C. Similarly + -- for left OR ELSE right, with negated values. Note that this + -- rewrite causes some difficulties for coverage analysis because + -- of the introduction of the new variable C, which obscures the + -- structure of the test. + + -- We use this "old approach" by default for now, unless the + -- special debug switch gnatd.X is used. + + if not Debug_Flag_Dot_XX then + Op_Var := Make_Temporary (Loc, 'C', Related_Node => N); + + Insert_Action (N, + Make_Object_Declaration (Loc, + Defining_Identifier => + Op_Var, + Object_Definition => + New_Occurrence_Of (Standard_Boolean, Loc), + Expression => + New_Occurrence_Of (Shortcut_Ent, Loc))); + + Append_To (Actlist, + Make_Implicit_If_Statement (Right, + Condition => Make_Test_Expr (Right), + Then_Statements => New_List ( + Make_Assignment_Statement (LocR, + Name => New_Occurrence_Of (Op_Var, LocR), + Expression => + New_Occurrence_Of + (Boolean_Literals (not Shortcut_Value), LocR))))); + + Insert_Action (N, + Make_Implicit_If_Statement (Left, + Condition => Make_Test_Expr (Left), + Then_Statements => Actlist)); + + Rewrite (N, New_Occurrence_Of (Op_Var, Loc)); + Analyze_And_Resolve (N, Standard_Boolean); + + -- The new approach, activated for now by the use of debug flag + -- -gnatd.X is to use the new Expression_With_Actions node for the + -- right operand of the short-circuit form. This should solve the + -- traceability problems for coverage analysis. + + else + Rewrite (Right, + Make_Expression_With_Actions (LocR, + Expression => Relocate_Node (Right), + Actions => Actlist)); + Analyze_And_Resolve (Right, Standard_Boolean); + end if; + + -- Special processing necessary for SCIL generation for AND THEN + -- with a function call as the right operand. + + -- What is this about, and is it needed for both cases above??? if Generate_SCIL and then Kind = N_And_Then @@ -8865,7 +8887,6 @@ package body Exp_Ch4 is Adjust_SCIL_Node (N, Right); end if; - Analyze_And_Resolve (N, Standard_Boolean); Adjust_Result_Type (N, Typ); return; end if; Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 160923) +++ sem_ch4.adb (working copy) @@ -1589,6 +1589,25 @@ package body Sem_Ch4 is Check_Parameterless_Call (N); end Analyze_Expression; + ------------------------------------- + -- Analyze_Expression_With_Actions -- + ------------------------------------- + + procedure Analyze_Expression_With_Actions (N : Node_Id) is + A : Node_Id; + + begin + A := First (Actions (N)); + loop + Analyze (A); + Next (A); + exit when No (A); + end loop; + + Analyze_Expression (Expression (N)); + Set_Etype (N, Etype (Expression (N))); + end Analyze_Expression_With_Actions; + ------------------------------------ -- Analyze_Indexed_Component_Form -- ------------------------------------ @@ -6119,8 +6138,8 @@ package body Sem_Ch4 is First_Actual : Node_Id; begin - -- Place the name of the operation, with its interpretations, on the - -- rewritten call. + -- Place the name of the operation, with its interpretations, + -- on the rewritten call. Set_Name (Call_Node, Subprog); Index: sem_ch4.ads =================================================================== --- sem_ch4.ads (revision 160923) +++ sem_ch4.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, 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- -- @@ -35,6 +35,7 @@ package Sem_Ch4 is procedure Analyze_Conditional_Expression (N : Node_Id); procedure Analyze_Equality_Op (N : Node_Id); procedure Analyze_Explicit_Dereference (N : Node_Id); + procedure Analyze_Expression_With_Actions (N : Node_Id); procedure Analyze_Logical_Op (N : Node_Id); procedure Analyze_Membership_Op (N : Node_Id); procedure Analyze_Negation (N : Node_Id); Index: sprint.adb =================================================================== --- sprint.adb (revision 160923) +++ sprint.adb (working copy) @@ -1509,6 +1509,20 @@ package body Sprint is Write_Char_Sloc ('.'); Write_Str_Sloc ("all"); + when N_Expression_With_Actions => + Indent_Begin; + Write_Indent_Str_Sloc ("do"); + Indent_Begin; + Write_Indent; + Sprint_Node_List (Actions (Node)); + Indent_End; + Write_Indent; + Write_Str_With_Col_Check_Sloc ("in "); + Sprint_Node (Expression (Node)); + Write_Str_With_Col_Check (" end"); + Indent_End; + Write_Indent; + when N_Extended_Return_Statement => Write_Indent_Str_Sloc ("return "); Sprint_Node_List (Return_Object_Declarations (Node)); Index: sprint.ads =================================================================== --- sprint.ads (revision 160923) +++ sprint.ads (working copy) @@ -53,8 +53,8 @@ package Sprint is -- Convert wi Rounded_Result target@(source) -- Divide wi Treat_Fixed_As_Integer x #/ y -- Divide wi Rounded_Result x @/ y + -- Expression with actions do action; .. action; in expr end -- Expression with range check {expression} - -- Operator with range check {operator} (e.g. {+}) -- Free statement free expr [storage_pool = xxx] -- Freeze entity with freeze actions freeze entityname [ actions ] -- Implicit call to run time routine $routine-name @@ -69,6 +69,7 @@ package Sprint is -- Multiple concatenation expr && expr && expr ... && expr -- Multiply wi Treat_Fixed_As_Integer x #* y -- Multiply wi Rounded_Result x @* y + -- Operator with range check {operator} (e.g. {+}) -- Others choice for cleanup when all others -- Pop exception label %pop_xxx_exception_label -- Push exception label %push_xxx_exception_label (label)