Fix #2007.

CHANGELOG.md

@@ -27,6 +27,8 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 * Incorrect handling of `match` in lambda lifting (#2000).
 
+* Regression in checking of consumption (#2007).
+
 ## [0.25.2]
 
 ### Added

src/Language/Futhark/TypeChecker/Consumption.hs

@@ -481,8 +481,8 @@ consumeAsNeeded loc (Scalar (Record fs1)) (Scalar (Record fs2)) =
 consumeAsNeeded loc pt t =
   when (diet pt == Consume) $ consumeAliases loc $ aliases t
 
-checkArg :: ParamType -> Exp -> CheckM (Exp, TypeAliases)
-checkArg p_t e = do
+checkArg :: [(Exp, TypeAliases)] -> ParamType -> Exp -> CheckM (Exp, TypeAliases)
+checkArg prev p_t e = do
   ((e', e_als), e_cons) <- contain $ checkExp e
   consumed e_cons
   let e_t = typeOf e'
@@ -494,7 +494,20 @@ checkArg p_t e = do
   when (diet p_t == Consume) $ do
     noSelfAliases (locOf e) e_als
     consumeAsNeeded (locOf e) p_t e_als
+    case mapMaybe prevAlias $ S.toList $ boundAliases $ aliases e_als of
+      [] -> pure ()
+      (v, prev_arg) : _ ->
+        addError (locOf e) mempty $
+          "Argument is consumed, but aliases"
+            </> indent 2 (prettyName v)
+            </> "which is also aliased by other argument"
+            </> indent 2 (pretty prev_arg)
+            </> "at"
+            <+> pretty (locTextRel (locOf e) (locOf prev_arg)) <> "."
   pure (e', e_als)
+  where
+    prevAlias v =
+      (v,) . fst <$> find (S.member v . boundAliases . aliases . snd) prev
 
 -- | @returnType appres ret_type arg_diet arg_type@ gives result of applying
 -- an argument the given types to a function with the given return
@@ -643,7 +656,7 @@ checkLoop loop_loc (param, arg, form, body) = do
   param' <- convergeLoopParam loop_loc param (M.keysSet body_cons) body_als
 
   let param_t = patternType param'
-  ((arg', arg_als), arg_cons) <- contain $ checkArg param_t arg
+  ((arg', arg_als), arg_cons) <- contain $ checkArg [] param_t arg
   consumed arg_cons
   free_bound <- boundFreeInExp body
 
@@ -673,29 +686,34 @@ checkFuncall ::
   TypeAliases ->
   f TypeAliases ->
   CheckM TypeAliases
-checkFuncall loc fname f_als args_als = do
+checkFuncall loc fname f_als arg_als = do
   v <- VName "internal_app_result" <$> incCounter
   modify $ \s -> s {stateNames = M.insert v (NameAppRes fname loc) $ stateNames s}
-  pure $ foldl applyArg (second (S.insert (AliasFree v)) f_als) args_als
+  pure $ foldl applyArg (second (S.insert (AliasFree v)) f_als) arg_als
 
 checkExp :: Exp -> CheckM (Exp, TypeAliases)
 -- First we have the complicated cases.
 
 --
 checkExp (AppExp (Apply f args loc) appres) = do
-  -- Note Futhark uses right-to-left evaluation of applications.
-  (args', args_als) <- NE.unzip . NE.reverse <$> traverse checkArg' (NE.reverse args)
+  (args', args_als) <- NE.unzip <$> checkArgs args
   (f', f_als) <- checkExp f
   res_als <- checkFuncall loc (fname f) f_als args_als
   pure (AppExp (Apply f' args' loc) appres, res_als)
   where
     fname (Var v _ _) = Just v
     fname (AppExp (Apply e _ _) _) = fname e
     fname _ = Nothing
-    checkArg' (Info (d, p), e) = do
-      (e', e_als) <- checkArg (second (const d) (typeOf e)) e
+    checkArg' prev (Info (d, p), e) = do
+      (e', e_als) <- checkArg prev (second (const d) (typeOf e)) e
       pure ((Info (d, p), e'), e_als)
 
+    checkArgs (x NE.:| args') = do
+      -- Note Futhark uses right-to-left evaluation of applications.
+      args'' <- maybe (pure []) (fmap NE.toList . checkArgs) $ NE.nonEmpty args'
+      (x', x_als) <- checkArg' (map (first snd) args'') x
+      pure $ (x', x_als) NE.:| args''
+
 --
 checkExp (AppExp (Loop sparams pat args form body loc) appres) = do
   ((pat', args', form', body'), als) <- checkLoop (locOf loc) (pat, args, form, body)
@@ -777,8 +795,8 @@ checkExp (AppExp (LetFun fname (typarams, params, te, Info (RetType ext ret), fu
 checkExp (AppExp (BinOp (op, oploc) opt (x, xp) (y, yp) loc) appres) = do
   op_als <- observeVar (locOf oploc) (qualLeaf op) (unInfo opt)
   let at1 : at2 : _ = fst $ unfoldFunType op_als
-  (x', x_als) <- checkArg at1 x
-  (y', y_als) <- checkArg at2 y
+  (x', x_als) <- checkArg [] at1 x
+  (y', y_als) <- checkArg [(x', x_als)] at2 y
   res_als <- checkFuncall loc (Just op) op_als [x_als, y_als]
   pure
     ( AppExp (BinOp (op, oploc) opt (x', xp) (y', yp) loc) appres,

tests/uniqueness/uniqueness-error64.fut

@@ -0,0 +1,5 @@
+-- From #2007
+-- ==
+-- error: Argument is consumed
+
+def main (xs: *[]i64) = scatter xs xs xs