opDependencies: fix Hist case.

CHANGELOG.md

@@ -33,6 +33,10 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 * Avoid generating invalid code in cases where deduplicated sum types
   are exposed through entry points (#1960).
 
+* A bug in data dependency analysis for histogram operations would
+  mistakenly classify some loop parameters as redundant, leaving to
+  code being removed.
+
 ## [0.25.7]
 
 ### Added

src/Futhark/Analysis/DataDependencies.hs

@@ -50,8 +50,18 @@ dataDependencies' startdeps = foldl grow startdeps . bodyStms
     grow deps (Let pat _ (Op op)) =
       let op_deps = map (depsOfNames deps) (opDependencies op)
           pat_deps = map (depsOfNames deps . freeIn) (patElems pat)
-       in M.fromList (zip (patNames pat) $ zipWith (<>) pat_deps op_deps)
-            `M.union` deps
+       in if length op_deps /= length pat_deps
+            then
+              error . unlines $
+                [ "dataDependencies':",
+                  "Pattern size: " <> show (length pat_deps),
+                  "Op deps size: " <> show (length op_deps),
+                  "Expression:\n",
+                  prettyString op
+                ]
+            else
+              M.fromList (zip (patNames pat) $ zipWith (<>) pat_deps op_deps)
+                `M.union` deps
     grow deps (Let pat _ (Match c cases defbody _)) =
       let cases_deps = map (dataDependencies' deps . caseBody) cases
           defbody_deps = dataDependencies' deps defbody

src/Futhark/IR/SOACS/SOAC.hs

@@ -605,15 +605,15 @@ instance (ASTRep rep) => IsOp (SOAC rep) where
     let bucket_fun_deps' = lambdaDependencies mempty lam (depsOfArrays w arrs)
         -- Bucket function results are indices followed by values.
         -- Reshape this to align with list of histogram operations.
-        ranks = [length (histShape op) | op <- ops]
-        value_lengths = [length (histNeutral op) | op <- ops]
+        ranks = map (shapeRank . histShape) ops
+        value_lengths = map (length . histNeutral) ops
         (indices, values) = splitAt (sum ranks) bucket_fun_deps'
         bucket_fun_deps =
           zipWith
             concatIndicesToEachValue
             (chunks ranks indices)
             (chunks value_lengths values)
-     in mconcat $ zipWith (<>) bucket_fun_deps (map depsOfHistOp ops)
+     in mconcat $ zipWith (zipWith (<>)) bucket_fun_deps (map depsOfHistOp ops)
     where
       depsOfHistOp (HistOp dest_shape rf dests nes op) =
         let shape_deps = depsOfShape dest_shape