From patchwork Mon Oct 9 20:37:27 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 823498 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-463820-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="lBlLnLoG"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3y9sW60dV0z9t4b for ; Tue, 10 Oct 2017 07:37:37 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=SBbMvTtl0ReLocZONB2Pt22DLKUx/uuWUmBPmAWnYrJXXoXUvY N5ZDUnmjsjKHT8ae6wD9VBlIb6nIgSDW2mmQekEsfqmhMIvb8Um6n5tXG0x62TsL gQCG5s0ACl2mQMsbcwQ0nhdq4IF8BRv08CjGd8aWEc1QQmUzdrtns+X/Q= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=17NePf7qS4vqNZ1I7xYJR1HLu8Q=; b=lBlLnLoG3QXsd1WL00s1 3rmdeEckb2QxVM8UjxHvh2QjQpSuD9hV7oI6MnLw/i/3g+jctIMS8PElcEZqfuNA M8uUe/Kvp8Z3BwX67MV1ydu7QNAHaTCHmBijHMYRoTHnOt3eB5v+oUweHH14t4y4 G4lGyBmRXwCN+5V2qHDjQfQ= Received: (qmail 47953 invoked by alias); 9 Oct 2017 20:37:30 -0000 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 Received: (qmail 47928 invoked by uid 89); 9 Oct 2017 20:37:30 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=prim, 1987 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 09 Oct 2017 20:37:28 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 6D3565631C; Mon, 9 Oct 2017 16:37:27 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id Xf-5oGJ4Gim4; Mon, 9 Oct 2017 16:37:27 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 5BEEB56004; Mon, 9 Oct 2017 16:37:27 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 5AFFE43A; Mon, 9 Oct 2017 16:37:27 -0400 (EDT) Date: Mon, 9 Oct 2017 16:37:27 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Support for reverse iteration on formal containers Message-ID: <20171009203727.GA1268@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This patch adds support for reverse iterations over formal containers, analogous to what is supported on arrays and predefined containers. Executing: gnatmake -q foo foo must yield; 1 2 3 4 5 6 7 8 9 10 10 9 8 7 6 5 4 3 2 1 10 9 8 7 6 5 4 3 2 1 --- with Ada.Text_IO; use Ada.Text_IO; procedure Foo is type Int_Range is record First, Last : Integer; end record with Iterable => (First => First, Next => Next, Previous => Previous, Last => Last, Has_Element => Has_Element, Element => Element); function First (IR : Int_Range) return Integer is (IR.First); function Last (IR : Int_Range) return Integer is (IR.Last); function Next (IR : Int_Range; N : Integer) return Integer is (N + 1); function Previous (IR : Int_Range; N : Integer) return Integer is (N - 1); function Has_Element (IR : Int_Range; N : Integer) return Boolean is (N in IR.First ..IR.Last); function Element (IR : Int_Range; N : Integer) return Integer is (N); IR : Int_Range := (1, 10); begin for I of IR loop Put (I'Img); end loop; New_Line; for I in reverse IR loop Put (I'Img); end loop; New_Line; for I of reverse IR loop Put (I'Img); end loop; end Foo; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-10-09 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specification, Check_Reverse_Iteration): Check that the domain of iteration supports reverse iteration when it is a formal container. This requires the presence of a Previous primitive in the Iterable aspect. * sem_ch13.adb (Resolve_Iterable_Operation): Verify legality of primitives Last and Previous to support reverse iteration over formal containers. (Validate_Iterable_Aspect): Add check for reverse iteration operations. * exp_ch5.adb (Build_Formal_Container_Iteration): Add proper expansion for reverse iteration using primitives Last and Previous in generated loop. Index: exp_ch5.adb =================================================================== --- exp_ch5.adb (revision 253566) +++ exp_ch5.adb (working copy) @@ -178,14 +178,27 @@ Loc : constant Source_Ptr := Sloc (N); Stats : constant List_Id := Statements (N); Typ : constant Entity_Id := Base_Type (Etype (Container)); - First_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_First); - Next_Op : constant Entity_Id := - Get_Iterable_Type_Primitive (Typ, Name_Next); + First_Op : Entity_Id; + Next_Op : Entity_Id; + Has_Element_Op : constant Entity_Id := Get_Iterable_Type_Primitive (Typ, Name_Has_Element); begin + -- Use the proper set of primitives depending on the direction of + -- iteration. The legality of a reverse iteration has been checked + -- during analysis. + + if Reverse_Present (Iterator_Specification (Iteration_Scheme (N))) then + First_Op := Get_Iterable_Type_Primitive (Typ, Name_Last); + Next_Op := Get_Iterable_Type_Primitive (Typ, Name_Previous); + + else + First_Op := Get_Iterable_Type_Primitive (Typ, Name_First); + Next_Op := Get_Iterable_Type_Primitive (Typ, Name_Next); + null; + end if; + -- Declaration for Cursor Init := @@ -198,7 +211,7 @@ Parameter_Associations => New_List ( Convert_To_Iterable_Type (Container, Loc)))); - -- Statement that advances cursor in loop + -- Statement that advances (in the right direction) cursor in loop Advance := Make_Assignment_Statement (Loc, Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 253563) +++ sem_ch13.adb (working copy) @@ -13200,10 +13200,13 @@ Ent := Entity (N); F1 := First_Formal (Ent); - if Nam = Name_First then - -- First (Container) => Cursor + if Nam = Name_First + or else Nam = Name_Last + then + -- First or Last (Container) => Cursor + if Etype (Ent) /= Cursor then Error_Msg_N ("primitive for First must yield a curosr", N); end if; @@ -13221,6 +13224,19 @@ Error_Msg_N ("no match for Next iterable primitive", N); end if; + elsif Nam = Name_Previous then + + -- Previous (Container, Cursor) => Cursor + + F2 := Next_Formal (F1); + + if Etype (F2) /= Cursor + or else Etype (Ent) /= Cursor + or else Present (Next_Formal (F2)) + then + Error_Msg_N ("no match for Previous iterable primitive", N); + end if; + elsif Nam = Name_Has_Element then -- Has_Element (Container, Cursor) => Boolean @@ -14022,6 +14038,7 @@ Cursor : constant Entity_Id := Get_Cursor_Type (ASN, Typ); First_Id : Entity_Id; + Last_Id : Entity_Id; Next_Id : Entity_Id; Has_Element_Id : Entity_Id; Element_Id : Entity_Id; @@ -14034,6 +14051,7 @@ end if; First_Id := Empty; + Last_Id := Empty; Next_Id := Empty; Has_Element_Id := Empty; Element_Id := Empty; @@ -14054,6 +14072,14 @@ Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_First); First_Id := Entity (Expr); + elsif Chars (Prim) = Name_Last then + Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Last); + Last_Id := Entity (Expr); + + elsif Chars (Prim) = Name_Previous then + Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Previous); + Last_Id := Entity (Expr); + elsif Chars (Prim) = Name_Next then Resolve_Iterable_Operation (Expr, Cursor, Typ, Name_Next); Next_Id := Entity (Expr); @@ -14082,7 +14108,9 @@ elsif No (Has_Element_Id) then Error_Msg_N ("match for Has_Element primitive not found", ASN); - elsif No (Element_Id) then + elsif No (Element_Id) + or else No (Last_Id) + then null; -- Optional. end if; end Validate_Iterable_Aspect; Index: sem_ch5.adb =================================================================== --- sem_ch5.adb (revision 253559) +++ sem_ch5.adb (working copy) @@ -1937,12 +1937,19 @@ procedure Check_Reverse_Iteration (Typ : Entity_Id) is begin - if Reverse_Present (N) - and then not Is_Array_Type (Typ) - and then not Is_Reversible_Iterator (Typ) - then - Error_Msg_NE - ("container type does not support reverse iteration", N, Typ); + if Reverse_Present (N) then + if Is_Array_Type (Typ) + or else Is_Reversible_Iterator (Typ) + or else + (Present (Find_Aspect (Typ, Aspect_Iterable)) + and then Present + (Get_Iterable_Type_Primitive (Typ, Name_Previous))) + then + null; + else + Error_Msg_NE + ("container type does not support reverse iteration", N, Typ); + end if; end if; end Check_Reverse_Iteration; @@ -2303,6 +2310,7 @@ ("missing Element primitive for iteration", N); else Set_Etype (Def_Id, Etype (Elt)); + Check_Reverse_Iteration (Typ); end if; end;