Patchwork [Ada] User-defined indexing operations

A user-defined indexing operation can have more than one index, for example
to describe user-defined matrix types.

The following must compile quietly:

     gcc -c -gnat12 test_indexing.adb

---
with Ada.Text_IO; use Ada.Text_IO;
with Project;     use Project;
with Matrix_3x3s; use Matrix_3x3s;
with Vector_3s;   use Vector_3s;
procedure Test_Indexing is
   procedure Display (X : Real) is
   begin
      Put_Line (Real'Image (X));
   end Display;
   V : Vector_3 := Create (X => 12.34,
                           Y => 123.4,
                           Z => 1234.0);
   M : Matrix_3x3 := (Create (X => V,
                              Y => V * 2.0,
                              Z => V * 4.0));
begin
   V (1) := 1.0;
   Display (V (1));
   Display (V (2));
   Display (V (3));
   M (1, 1) := 20.0;
   Display (M (1, 1));
end Test_Indexing;
---
with Project;             use Project;
with Project.Real_Arrays; use Project.Real_Arrays;
with Vector_3s;           use Vector_3s;
package Matrix_3x3s is
   pragma Pure (Matrix_3x3s);
   subtype An_Axis is Integer range 1 .. 3;
   type Matrix_3x3 is tagged private
     with Constant_Indexing => Matrix_3x3s.Constant_Reference,
          Variable_Indexing => Matrix_3x3s.Variable_Reference;
   function Create (X, Y, Z : Vector_3) return Matrix_3x3;
   type Constant_Reference_Type (Value : not null access constant Real) is
     private with Implicit_Dereference => Value;
   function Constant_Reference (This : Matrix_3x3;
                                X, Y : An_Axis) return Constant_Reference_Type;
   type Reference_Type (Value : not null access Real) is
     private with Implicit_Dereference => Value;
   function Variable_Reference (This : Matrix_3x3;
                                X, Y : An_Axis) return Reference_Type;
private
   type Matrix_3x3 is tagged record
      M : Real_Matrix (An_Axis, An_Axis);
   end record;
   function Create (X, Y, Z : Vector_3) return Matrix_3x3 is
     (M => (1 => (X.Get_X, X.Get_Y, X.Get_Z),
            2 => (Y.Get_X, Y.Get_Y, Y.Get_Z),
            3 => (Z.Get_X, Z.Get_Y, Z.Get_Z)));
   type Constant_Reference_Type (Value : not null access constant Real) is
     null record;
   type Reference_Type (Value : not null access Real) is
     null record;
   function Constant_Reference (This : Matrix_3x3;
                                X, Y : An_Axis)
                                return Constant_Reference_Type is
      (Value => This.M (X, Y)'Unrestricted_Access);
   function Variable_Reference (This : Matrix_3x3;
                                X, Y : An_Axis)
                                return Reference_Type is
      (Value => This.M (X, Y)'Unrestricted_Access);
end Matrix_3x3s;
---
with Ada.Numerics.Long_Real_Arrays;
package Project.Real_Arrays
   renames Ada.Numerics.Long_Real_Arrays;
package Project is
   pragma Pure (Project);
   subtype Real is Long_Float;
   pragma Assert (Real'Size >= 64);
   subtype Non_Negative_Real is Real range 0.0 .. Real'Last;
   subtype Positive_Real     is Real range Real'Succ (0.0) .. Real'Last;
end Project;
---
with Project;             use Project;
with Project.Real_Arrays; use Project.Real_Arrays;
package Vector_3s is
   pragma Pure (Vector_3s);
   subtype An_Axis is Integer range 1 .. 3;
   type Vector_3 is tagged private
     with Constant_Indexing => Vector_3s.Constant_Reference,
          Variable_Indexing => Vector_3s.Variable_Reference;
   function Create (X, Y, Z : Real) return Vector_3;
   function Get_X (This : Vector_3) return Real;
   function Get_Y (This : Vector_3) return Real;
   function Get_Z (This : Vector_3) return Real;
   function "*" (Left : Vector_3;
                 Right : Real'Base)
                 return Vector_3;
   subtype Real_Vector_3 is Real_Vector (An_Axis);
   type Constant_Reference_Type (Value : not null access constant Real) is
     private with Implicit_Dereference => Value;
   function Constant_Reference (This : Vector_3;
                                Axis : An_Axis)
                                return Constant_Reference_Type;
   type Reference_Type (Value : not null access Real) is
     private with Implicit_Dereference => Value;
   function Variable_Reference (This : Vector_3;
                                Axis : An_Axis)
                                return Reference_Type;
private
   type Vector_3 is tagged record
      V : Real_Vector (An_Axis);
   end record;
   function Create (X, Y, Z : Real) return Vector_3 is
     (V => (1 => X, 2 => Y, 3 => Z));
   function Get_X (This : Vector_3) return Real is
     (This.V (1));
   function Get_Y (This : Vector_3) return Real is
     (This.V (2));
   function Get_Z (This : Vector_3) return Real is
     (This.V (3));
   function "*" (Left : Vector_3; Right : Real'Base) return Vector_3 is
     (V => Left.V * Right);
   type Constant_Reference_Type (Value : not null access constant Real) is
     null record;
   type Reference_Type (Value : not null access Real) is
     null record;
   function Constant_Reference (This : Vector_3;
                                Axis : An_Axis)
                                return Constant_Reference_Type is
      (Value => This.V (Axis)'Unrestricted_Access);
   function Variable_Reference (This : Vector_3;
                                Axis : An_Axis)
                                return Reference_Type is
      (Value => This.V (Axis)'Unrestricted_Access);
end Vector_3s;

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

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing): A user-defined indexing
	aspect can have more than one index, e.g. to describe indexing
	of a multidimensional object.