[Ada] Support for reverse iteration on formal containers

Message ID 20171009203727.GA1268@adacore.com
State New
Headers show
Series
  • [Ada] Support for reverse iteration on formal containers
Related show

Commit Message

Pierre-Marie de Rodat Oct. 9, 2017, 8:37 p.m.
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  <schonberg@adacore.com>

	* 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.

Patch

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;