Better type inference for V<n> pattern synonyms

Previously, the V<n> pattern synonyms (V2, V4, etc.) had suboptimal
typing in two different ways:

1. They did not force the type constructor of the constructed vector to
   be `Vec`, hence the following type annotation was required absent
   external type signatures:
   > generate (I1 10000) (\(I1 idx) -> V2 idx (idx + 1) :: Exp (Vec _ _))
2. The IsVector instances required it to be known that the types of each
   of the arguments of V<n> are equal before the instance could be
   selected. This means that these type annotations were also required:
   > fold1 (\(V2 a b) (V2 c d) -> V2 (a + c :: Exp Int) (b * d :: Exp Int)) $
   >   generate _ _

This commit fixes both issues, meaning that the following code is now
accepted in ghci:

> fold1 (\(V2 a b) (V2 c d) -> V2 (a + c) (b * d)) $
>   generate (I1 10000) (\(I1 idx) -> V2 idx (idx + 1))

Author: tomsmeding

src/Data/Array/Accelerate/Data/Complex.hs

@@ -178,7 +178,7 @@ constructComplex :: forall a. Elt a => Exp a -> Exp a -> Exp (Complex a)
 constructComplex r i =
   case complexR (eltR @a) of
     ComplexTup   -> coerce $ T2 r i
-    ComplexVec _ -> V2 (coerce @a @(EltR a) r) (coerce @a @(EltR a) i)
+    ComplexVec _ -> coerce $ V2 (coerce @a @(EltR a) r) (coerce @a @(EltR a) i)
 
 deconstructComplex :: forall a. Elt a => Exp (Complex a) -> (Exp a, Exp a)
 deconstructComplex c@(Exp c') =

src/Data/Array/Accelerate/Pattern.hs

@@ -188,22 +188,35 @@ runQ $ do
             |]
 
         -- Generate instance declarations for IsVector of the form:
-        -- instance (Elt v, EltR v ~ Vec 2 a, Elt a) => IsVector Exp v (Exp a, Exp a)
+        -- instance (Elt v, EltR v ~ Vec 2 a1, Elt a1, a1 ~ a2) => IsVector Exp v (Exp a1, Exp a2)
+        -- The element type is `a1`; we leave the element types for each of the
+        -- tuple components as separate type variables in the instance head
+        -- (only to equate them in the instance context) so that type inference
+        -- can already select this instance before it is known that the tuple
+        -- elements are indeed homogeneously typed.
         mkVecPattern :: Int -> Q [Dec]
+        mkVecPattern n | n <= 0 = error "mkVecPattern: must be > 0"
         mkVecPattern n = do
-          a <- newName "a"
+          as@(a1 : a2s) <- mapM (\i -> newName ("a" ++ show i)) [1 .. n]
           v <- newName "v"
           let
-              -- Last argument to `IsVector`, eg (Exp, a, Exp a) in the example
-              tup      = tupT (replicate n ([t| Exp $(varT a)|]))
-              -- Representation as a vector, eg (Vec 2 a)
-              vec      = [t| Vec $(litT (numTyLit (fromIntegral n))) $(varT a) |]
-              -- Constraints for the type class, consisting of Elt constraints on all type variables,
-              -- and an equality constraint on the representation type of `a` and the vector representation `vec`.
-              context  = [t| (Elt $(varT v), VecElt $(varT a), EltR $(varT v) ~ $vec) |]
+              -- Last argument to `IsVector`, eg (Exp a1, Exp a2) in the example
+              tup      = tupT [ [t| Exp $(varT ai) |] | ai <- as ]
+              -- Representation as a vector, eg (Vec 2 a1)
+              vec      = [t| Vec $(litT (numTyLit (fromIntegral n))) $(varT a1) |]
+              -- Constraints for the type class, consisting of:
+              -- - Elt constraints on all type variables;
+              -- - an equality constraint on the representation type of `a` and
+              --   the vector representation `vec`;
+              -- - equality constraints for the `ai` variables.
+              context  = tupT $ [t| Elt $(varT v) |]
+                              : [t| VecElt $(varT a1) |]
+                              : [t| EltR $(varT v) ~ $vec |]
+                              : [ [t| $(varT a1) ~ $(varT ai) |] | ai <- a2s]
               --
-              vecR     = foldr appE ([| VecRnil |] `appE` (varE 'singleType `appTypeE` varT a)) (replicate n [| VecRsucc |])
-              tR       = tupT (replicate n (varT a))
+              vecR     = iterate ([| VecRsucc |] `appE`) [| VecRnil (singleType @($(varT a1))) |]
+                           Prelude.!! n
+              tR       = tupT (replicate n (varT a1))
           --
           [d| instance $context => IsVector Exp $(varT v) $tup where
                 vpack x = case builder x :: Exp $tR of
@@ -273,12 +286,13 @@ runQ $ do
             ]
 
         mkV :: Int -> Q [Dec]
+        mkV n | n <= 0 = error "mkV: must be > 0"
         mkV n =
           let xs    = [ mkName ('x' : show i) | i <- [0 .. n-1] ]
               ts    = map varT xs
               name  = mkName ('V':show n)
               con   = varT (mkName "con")
-              ty1   = varT (mkName "vec")
+              ty1   = [t| Vec $(litT (numTyLit (fromIntegral n))) $(varT (head xs)) |]
               ty2   = tupT (map (con `appT`) ts)
               sig   = foldr (\t r -> [t| $con $t -> $r |]) (appT con ty1) ts
           in