From da9cface951ffa2550106528cf47ee6f46e01404 Mon Sep 17 00:00:00 2001
From: Troels Henriksen <athas@sigkill.dk>
Date: Fri, 28 Jun 2019 08:18:42 +0200
Subject: [PATCH] Fix #774.

---
 src/Futhark/Optimise/InPlaceLowering.hs       | 20 +++++++++++--------
 .../Optimise/InPlaceLowering/LowerIntoStm.hs  |  5 +++++
 tests/issue774.fut                            | 15 ++++++++++++++
 3 files changed, 32 insertions(+), 8 deletions(-)
 create mode 100644 tests/issue774.fut

diff --git a/src/Futhark/Optimise/InPlaceLowering.hs b/src/Futhark/Optimise/InPlaceLowering.hs
index 68e99d76ea..fbad1a2e72 100644
--- a/src/Futhark/Optimise/InPlaceLowering.hs
+++ b/src/Futhark/Optimise/InPlaceLowering.hs
@@ -10,11 +10,12 @@
 -- minimising memory copies.  As an example, consider this program:
 --
 -- @
---   loop (r = r0) = for i < n do
---     let a = r[i] in
---     let r[i] = a * i in
---     r
---     in
+--   let r =
+--     loop (r1 = r0) = for i < n do
+--       let a = r1[i] in
+--       let r1[i] = a * i in
+--       r1
+--       in
 --   ...
 --   let x = y with [k] <- r in
 --   ...
@@ -48,7 +49,7 @@
 --    (4) If @x@ is consumed at a point after the loop, @r@ must not
 --    be used after that point.
 --
---    (5) The size of @r@ is invariant inside the loop.
+--    (5) The size of @r1@ is invariant inside the loop.
 --
 --    (6) The value @r@ must come from something that we can actually
 --    optimise (e.g. not a function parameter).
@@ -56,8 +57,11 @@
 --    (7) @y@ (or its aliases) may not be used inside the body of the
 --    loop.
 --
--- FIXME: the implementation is not finished yet.  Specifically, the
--- above conditions are not really checked.
+--    (8) The result of the loop may not alias the merge parameter
+--    @r1@.
+--
+-- FIXME: the implementation is not finished yet.  Specifically, not
+-- all of the above conditions are checked.
 module Futhark.Optimise.InPlaceLowering
        (
          inPlaceLowering
diff --git a/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs b/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs
index f37883f278..af8517fc5e 100644
--- a/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs
+++ b/src/Futhark/Optimise/InPlaceLowering/LowerIntoStm.hs
@@ -135,7 +135,12 @@ lowerUpdateIntoLoop scope updates pat ctx val form body = do
   --
   -- We also check that the merge parameters we work with have
   -- loop-invariant shapes.
+
+  forM_ (zip val $ bodyAliases body) $ \((p, _), als) ->
+    guard $ not $ paramName p `S.member` als
+
   mk_in_place_map <- summariseLoop updates usedInBody resmap val
+
   Just $ do
     in_place_map <- mk_in_place_map
     (val',prebnds,postbnds) <- mkMerges in_place_map
diff --git a/tests/issue774.fut b/tests/issue774.fut
new file mode 100644
index 0000000000..a941929534
--- /dev/null
+++ b/tests/issue774.fut
@@ -0,0 +1,15 @@
+-- In-place lowering should be careful about updates where the new
+-- value potentially aliases the old one.
+
+type t = [8]u32
+
+let zero: t = replicate 8 0
+
+let pack [n] (xs: [n]bool): t =
+  loop ret = zero for i in 0..<n do
+    if xs[i]
+    then map1 (+1) ret
+    else ret
+
+let main =
+  map (\x -> replicate 2 (x >= 4) |> pack) (iota 10)