Fix #1271.

CHANGELOG.md

@@ -18,6 +18,8 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
   * Mismatch between how thresholds were printed and what the
     autotuner was looking for (#1269).
 
+  * `zip` now produces unique arrays (#1271).
+
 ## [0.19.2]
 
 ### Added

prelude/zip.fut

@@ -14,23 +14,23 @@ local let internal_map 'a [n] 'x (f: a -> x) (as: [n]a): [n]x =
   intrinsics.map (f, as) :> [n]x
 
 -- | Construct an array of pairs from two arrays.
-let zip [n] 'a 'b (as: [n]a) (bs: [n]b): [n](a,b) =
-  intrinsics.zip (as, bs) :> [n](a,b)
+let zip [n] 'a 'b (as: [n]a) (bs: [n]b): *[n](a,b) =
+  intrinsics.zip (as, bs) :> *[n](a,b)
 
 -- | Construct an array of pairs from two arrays.
-let zip2 [n] 'a 'b (as: [n]a) (bs: [n]b): [n](a,b) =
+let zip2 [n] 'a 'b (as: [n]a) (bs: [n]b): *[n](a,b) =
   zip as bs :> [n](a,b)
 
 -- | As `zip2`@term, but with one more array.
-let zip3 [n] 'a 'b 'c (as: [n]a) (bs: [n]b) (cs: [n]c): [n](a,b,c) =
+let zip3 [n] 'a 'b 'c (as: [n]a) (bs: [n]b) (cs: [n]c): *[n](a,b,c) =
   internal_map (\(a,(b,c)) -> (a,b,c)) (zip as (zip2 bs cs))
 
 -- | As `zip3`@term, but with one more array.
-let zip4 [n] 'a 'b 'c 'd (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d): [n](a,b,c,d) =
+let zip4 [n] 'a 'b 'c 'd (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d): *[n](a,b,c,d) =
   internal_map (\(a,(b,c,d)) -> (a,b,c,d)) (zip as (zip3 bs cs ds))
 
 -- | As `zip4`@term, but with one more array.
-let zip5 [n] 'a 'b 'c 'd 'e (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d) (es: [n]e): [n](a,b,c,d,e) =
+let zip5 [n] 'a 'b 'c 'd 'e (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d) (es: [n]e): *[n](a,b,c,d,e) =
   internal_map (\(a,(b,c,d,e)) -> (a,b,c,d,e)) (zip as (zip4 bs cs ds es))
 
 -- | Turn an array of pairs into two arrays.

src/Futhark/Internalise.hs

@@ -1712,8 +1712,11 @@ isOverloadedFunction qname args loc = do
         r <- I.arrayRank <$> lookupType v
         return $ I.Rearrange ([1, 0] ++ [2 .. r -1]) v
     handleRest [TupLit [x, y] _] "zip" = Just $ \desc ->
-      (++) <$> internaliseExp (desc ++ "_zip_x") x
-        <*> internaliseExp (desc ++ "_zip_y") y
+      mapM (letSubExp "zip_copy" . BasicOp . Copy)
+        =<< ( (++)
+                <$> internaliseExpToVars (desc ++ "_zip_x") x
+                <*> internaliseExpToVars (desc ++ "_zip_y") y
+            )
     handleRest [x] "unzip" = Just $ flip internaliseExp x
     handleRest [x] "trace" = Just $ flip internaliseExp x
     handleRest [x] "break" = Just $ flip internaliseExp x

src/Language/Futhark/Prop.hs

@@ -892,7 +892,7 @@ intrinsics =
                  ]
                  uarr_3d_a
              ),
-             ("zip", IntrinsicPolyFun [tp_a, tp_b] [arr_a, arr_b] arr_a_b),
+             ("zip", IntrinsicPolyFun [tp_a, tp_b] [arr_a, arr_b] uarr_a_b),
              ("unzip", IntrinsicPolyFun [tp_a, tp_b] [arr_a_b] t_arr_a_arr_b),
              ( "hist",
                IntrinsicPolyFun
@@ -989,6 +989,7 @@ intrinsics =
         Nonunique
         (Record (M.fromList $ zip tupleFieldNames [Scalar t_a, Scalar t_b]))
         (rank 1)
+    uarr_a_b = arr_a_b `setUniqueness` Unique
     t_arr_a_arr_b = Scalar $ Record $ M.fromList $ zip tupleFieldNames [arr_a, arr_b]
 
     arr x y = Scalar $ Arrow mempty Unnamed x y

tests/uniqueness/uniqueness53.fut

@@ -0,0 +1,4 @@
+let main (xs: *[]i32) =
+  let xs' = zip xs xs
+  let xs'[0] = (0,0)
+  in xs'