diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,27 @@
 The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
 and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html).
 
+## [0.25.28]
+
+### Added
+
+### Removed
+
+### Changed
+
+### Fixed
+
+* Compiler crash for intrablock scatters that write to
+  multidimensional arrays. (#2218)
+
+* Handling of size expressions in abstract types in the interpreter (#2222).
+
+* GPU code generation of segmented reductions with array operands. (#2227)
+
+* Server-mode timing is now done with a monotonic clock.
+
+* `futhark test` now respects `notest`, similar to `nobench` for `futhark bench`.
+
 ## [0.25.27]
 
 ### Added
diff --git a/docs/man/futhark-test.rst b/docs/man/futhark-test.rst
--- a/docs/man/futhark-test.rst
+++ b/docs/man/futhark-test.rst
@@ -151,8 +151,8 @@
 --exclude=tag
 
   Do not run test cases that contain the given tag.  Cases marked with
-  "disable" are ignored by default, as are cases marked "no_foo",
-  where *foo* is the backend used.
+  "notest", "disable", or "no_foo" (where *foo* is the backend used)
+  are ignored by default.
 
 -i
   Test with the interpreter.
diff --git a/futhark.cabal b/futhark.cabal
--- a/futhark.cabal
+++ b/futhark.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name:           futhark
-version:        0.25.27
+version:        0.25.28
 synopsis:       An optimising compiler for a functional, array-oriented language.
 
 description:    Futhark is a small programming language designed to be compiled to
diff --git a/rts/c/timing.h b/rts/c/timing.h
--- a/rts/c/timing.h
+++ b/rts/c/timing.h
@@ -24,17 +24,16 @@
 #include <time.h>
 #include <sys/time.h>
 
-static int64_t get_wall_time(void) {
-  struct timeval time;
-  assert(gettimeofday(&time,NULL) == 0);
-  return time.tv_sec * 1000000 + time.tv_usec;
-}
-
 static int64_t get_wall_time_ns(void) {
   struct timespec time;
-  assert(clock_gettime(CLOCK_REALTIME, &time) == 0);
+  assert(clock_gettime(CLOCK_MONOTONIC, &time) == 0);
   return time.tv_sec * 1000000000 + time.tv_nsec;
 }
+
+static int64_t get_wall_time(void) {
+  return get_wall_time_ns() / 1000;
+}
+
 
 #endif
 
diff --git a/src/Futhark/Analysis/Interference.hs b/src/Futhark/Analysis/Interference.hs
--- a/src/Futhark/Analysis/Interference.hs
+++ b/src/Futhark/Analysis/Interference.hs
@@ -159,11 +159,11 @@
   m (InUse, LastUsed, Graph VName)
 analyseSegOp lumap inuse (SegMap _ _ _ body) =
   analyseKernelBody lumap inuse body
-analyseSegOp lumap inuse (SegRed _ _ binops _ body) =
+analyseSegOp lumap inuse (SegRed _ _ _ body binops) =
   segWithBinOps lumap inuse binops body
-analyseSegOp lumap inuse (SegScan _ _ binops _ body) = do
+analyseSegOp lumap inuse (SegScan _ _ _ body binops) = do
   segWithBinOps lumap inuse binops body
-analyseSegOp lumap inuse (SegHist _ _ histops _ body) = do
+analyseSegOp lumap inuse (SegHist _ _ _ body histops) = do
   (inuse', lus', graph) <- analyseKernelBody lumap inuse body
   (inuse'', lus'', graph') <- mconcat <$> mapM (analyseHistOp lumap inuse') histops
   pure (inuse'', lus' <> lus'', graph <> graph')
diff --git a/src/Futhark/Analysis/LastUse.hs b/src/Futhark/Analysis/LastUse.hs
--- a/src/Futhark/Analysis/LastUse.hs
+++ b/src/Futhark/Analysis/LastUse.hs
@@ -312,17 +312,17 @@
   (used_nms', lu_vars) <- lastUsedInNames used_nms $ freeIn tps
   (body_lutab, used_nms'') <- lastUseKernelBody kbody (mempty, used_nms')
   pure (body_lutab, lu_vars, used_nms' <> used_nms'')
-lastUseSegOp (SegRed _ _ sbos tps kbody) used_nms = do
+lastUseSegOp (SegRed _ _ tps kbody sbos) used_nms = do
   (lutab_sbo, lu_vars_sbo, used_nms_sbo) <- lastUseSegBinOp sbos used_nms
   (used_nms', lu_vars) <- lastUsedInNames used_nms_sbo $ freeIn tps
   (body_lutab, used_nms'') <- lastUseKernelBody kbody (mempty, used_nms')
   pure (M.union lutab_sbo body_lutab, lu_vars <> lu_vars_sbo, used_nms_sbo <> used_nms' <> used_nms'')
-lastUseSegOp (SegScan _ _ sbos tps kbody) used_nms = do
+lastUseSegOp (SegScan _ _ tps kbody sbos) used_nms = do
   (lutab_sbo, lu_vars_sbo, used_nms_sbo) <- lastUseSegBinOp sbos used_nms
   (used_nms', lu_vars) <- lastUsedInNames used_nms_sbo $ freeIn tps
   (body_lutab, used_nms'') <- lastUseKernelBody kbody (mempty, used_nms')
   pure (M.union lutab_sbo body_lutab, lu_vars <> lu_vars_sbo, used_nms_sbo <> used_nms' <> used_nms'')
-lastUseSegOp (SegHist _ _ hos tps kbody) used_nms = do
+lastUseSegOp (SegHist _ _ tps kbody hos) used_nms = do
   (lutab_sbo, lu_vars_sbo, used_nms_sbo) <- lastUseHistOp hos used_nms
   (used_nms', lu_vars) <- lastUsedInNames used_nms_sbo $ freeIn tps
   (body_lutab, used_nms'') <- lastUseKernelBody kbody (mempty, used_nms')
diff --git a/src/Futhark/Analysis/MemAlias.hs b/src/Futhark/Analysis/MemAlias.hs
--- a/src/Futhark/Analysis/MemAlias.hs
+++ b/src/Futhark/Analysis/MemAlias.hs
@@ -68,11 +68,11 @@
 analyzeHostOp :: MemAliases -> HostOp NoOp GPUMem -> MemAliasesM (HostOp NoOp GPUMem) MemAliases
 analyzeHostOp m (SegOp (SegMap _ _ _ kbody)) =
   analyzeStms (kernelBodyStms kbody) m
-analyzeHostOp m (SegOp (SegRed _ _ _ _ kbody)) =
+analyzeHostOp m (SegOp (SegRed _ _ _ kbody _)) =
   analyzeStms (kernelBodyStms kbody) m
-analyzeHostOp m (SegOp (SegScan _ _ _ _ kbody)) =
+analyzeHostOp m (SegOp (SegScan _ _ _ kbody _)) =
   analyzeStms (kernelBodyStms kbody) m
-analyzeHostOp m (SegOp (SegHist _ _ _ _ kbody)) =
+analyzeHostOp m (SegOp (SegHist _ _ _ kbody _)) =
   analyzeStms (kernelBodyStms kbody) m
 analyzeHostOp m SizeOp {} = pure m
 analyzeHostOp m GPUBody {} = pure m
diff --git a/src/Futhark/CLI/Main.hs b/src/Futhark/CLI/Main.hs
--- a/src/Futhark/CLI/Main.hs
+++ b/src/Futhark/CLI/Main.hs
@@ -3,6 +3,7 @@
 
 import Control.Exception
 import Data.List (sortOn)
+import Data.List qualified as L
 import Data.Maybe
 import Data.Text.IO qualified as T
 import Futhark.CLI.Autotune qualified as Autotune
@@ -154,4 +155,6 @@
   case args of
     cmd : args'
       | Just (m, _) <- lookup cmd commands -> m (unwords [prog, cmd]) args'
+      | not $ "-" `L.isPrefixOf` cmd ->
+          optionsError $ "unknown subcommand \"" <> cmd <> "\"."
     _ -> mainWithOptions () [] msg (const . const Nothing) prog args
diff --git a/src/Futhark/CLI/Test.hs b/src/Futhark/CLI/Test.hs
--- a/src/Futhark/CLI/Test.hs
+++ b/src/Futhark/CLI/Test.hs
@@ -460,7 +460,7 @@
 
 makeTestCase :: TestConfig -> TestMode -> (FilePath, ProgramTest) -> TestCase
 makeTestCase config mode (file, spec) =
-  TestCase mode file spec $ configPrograms config
+  excludeCases config $ TestCase mode file spec $ configPrograms config
 
 data ReportMsg
   = TestStarted TestCase
@@ -677,7 +677,7 @@
 defaultConfig =
   TestConfig
     { configTestMode = Compiled,
-      configExclude = ["disable"],
+      configExclude = ["disable", "notest"],
       configPrograms =
         ProgConfig
           { configBackend = "c",
diff --git a/src/Futhark/CodeGen/ImpGen/GPU.hs b/src/Futhark/CodeGen/ImpGen/GPU.hs
--- a/src/Futhark/CodeGen/ImpGen/GPU.hs
+++ b/src/Futhark/CodeGen/ImpGen/GPU.hs
@@ -153,11 +153,11 @@
   CallKernelGen ()
 segOpCompiler pat (SegMap lvl space _ kbody) =
   compileSegMap pat lvl space kbody
-segOpCompiler pat (SegRed lvl@(SegThread _ _) space reds _ kbody) =
+segOpCompiler pat (SegRed lvl@(SegThread _ _) space _ kbody reds) =
   compileSegRed pat lvl space reds kbody
-segOpCompiler pat (SegScan lvl@(SegThread _ _) space scans _ kbody) =
+segOpCompiler pat (SegScan lvl@(SegThread _ _) space _ kbody scans) =
   compileSegScan pat lvl space scans kbody
-segOpCompiler pat (SegHist lvl@(SegThread _ _) space ops _ kbody) =
+segOpCompiler pat (SegHist lvl@(SegThread _ _) space _ kbody ops) =
   compileSegHist pat lvl space ops kbody
 segOpCompiler pat segop =
   compilerBugS $ "segOpCompiler: unexpected " ++ prettyString (segLevel segop) ++ " for rhs of pattern " ++ prettyString pat
diff --git a/src/Futhark/CodeGen/ImpGen/GPU/Block.hs b/src/Futhark/CodeGen/ImpGen/GPU/Block.hs
--- a/src/Futhark/CodeGen/ImpGen/GPU/Block.hs
+++ b/src/Futhark/CodeGen/ImpGen/GPU/Block.hs
@@ -365,7 +365,7 @@
       zipWithM_ (compileThreadResult space) (patElems pat) $
         kernelBodyResult body
   sOp $ Imp.ErrorSync Imp.FenceLocal
-compileBlockOp pat (Inner (SegOp (SegScan lvl space scans _ body))) = do
+compileBlockOp pat (Inner (SegOp (SegScan lvl space _ body scans))) = do
   compileFlatId space
 
   let (ltids, dims) = unzip $ unSegSpace space
@@ -412,7 +412,7 @@
         (product dims')
         (segBinOpLambda scan)
         arrs_flat
-compileBlockOp pat (Inner (SegOp (SegRed lvl space ops _ body))) = do
+compileBlockOp pat (Inner (SegOp (SegRed lvl space _ body ops))) = do
   compileFlatId space
 
   let dims' = map pe64 dims
@@ -533,7 +533,7 @@
             (map (unitSlice 0) (init dims') ++ [DimFix $ last dims' - 1])
 
       sOp $ Imp.Barrier Imp.FenceLocal
-compileBlockOp pat (Inner (SegOp (SegHist lvl space ops _ kbody))) = do
+compileBlockOp pat (Inner (SegOp (SegHist lvl space _ kbody ops))) = do
   compileFlatId space
   let (ltids, dims) = unzip $ unSegSpace space
 
diff --git a/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs b/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs
--- a/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs
+++ b/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs
@@ -143,7 +143,12 @@
 compileSegRed' pat grid space segbinops map_body_cont
   | genericLength segbinops > maxNumOps =
       compilerLimitationS $
-        ("compileSegRed': at most " <> show maxNumOps <> " reduction operators are supported.\n")
+        ( "compileSegRed': at most "
+            <> show maxNumOps
+            <> " reduction operators are supported,\nbut found kernel with "
+            <> show (length segbinops)
+            <> ".\n"
+        )
           <> ("Pattern: " <> prettyString pat)
   | otherwise = do
       chunk_v <- dPrimV "chunk_size" . isInt64 =<< kernelConstToExp chunk_const
@@ -192,7 +197,7 @@
     all isPrimSegBinOp segbinops =
       noncommPrimSegRedInterms
   | otherwise =
-      generalSegRedInterms tblock_id tblock_size segbinops
+      generalSegRedInterms False tblock_id tblock_size segbinops
   where
     params = map paramOf segbinops
 
@@ -246,24 +251,28 @@
     forAccumLM2D acc ls f = mapAccumLM (mapAccumLM f) acc ls
 
 generalSegRedInterms ::
+  Bool ->
   Imp.TExp Int64 ->
   SubExp ->
   [SegBinOp GPUMem] ->
   InKernelGen [SegRedIntermediateArrays]
-generalSegRedInterms tblock_id tblock_size segbinops =
-  fmap (map GeneralSegRedInterms) $
-    forM (map paramOf segbinops) $
-      mapM $ \p ->
-        case paramDec p of
-          MemArray pt shape _ (ArrayIn mem _) -> do
-            let shape' = Shape [tblock_size] <> shape
-            let shape_E = map pe64 $ shapeDims shape'
-            sArray ("red_arr_" ++ prettyString pt) pt shape' mem $
-              LMAD.iota (tblock_id * product shape_E) shape_E
-          _ -> do
-            let pt = elemType $ paramType p
-                shape = Shape [tblock_size]
-            sAllocArray ("red_arr_" ++ prettyString pt) pt shape $ Space "shared"
+generalSegRedInterms segmented tblock_id tblock_size segbinops =
+  fmap (map GeneralSegRedInterms) . forM (map paramOf segbinops) . mapM $ \p ->
+    case paramDec p of
+      MemArray pt shape _ (ArrayIn mem ixfun) -> do
+        let shape' = Shape [tblock_size] <> shape
+        let shape_E = map pe64 $ shapeDims shape'
+        sArray ("red_arr_" ++ prettyString pt) pt shape' mem $
+          -- This 'segmented' thing here is a hack, related to #2227.
+          -- There absolutely must be some unifying principle we are
+          -- missing.
+          if segmented
+            then ixfun
+            else LMAD.iota (tblock_id * product shape_E) shape_E
+      _ -> do
+        let pt = elemType $ paramType p
+            shape = Shape [tblock_size]
+        sAllocArray ("red_arr_" ++ prettyString pt) pt shape $ Space "shared"
 
 -- | Arrays for storing block results.
 --
@@ -380,7 +389,7 @@
     dPrimVE "segment_size_nonzero" $ sMax64 1 segment_size
 
   let tblock_size_se = unCount tblock_size
-      num_tblocks_se = unCount tblock_size
+      num_tblocks_se = unCount num_tblocks
       num_tblocks' = pe64 num_tblocks_se
       tblock_size' = pe64 tblock_size_se
   num_threads <- fmap tvSize $ dPrimV "num_threads" $ num_tblocks' * tblock_size'
@@ -399,7 +408,7 @@
     let tblock_id = kernelBlockSize constants
         ltid = sExt64 $ kernelLocalThreadId constants
 
-    interms <- generalSegRedInterms tblock_id tblock_size_se segbinops
+    interms <- generalSegRedInterms True tblock_id tblock_size_se segbinops
     let reds_arrs = map blockRedArrs interms
 
     -- We probably do not have enough actual threadblocks to cover the
@@ -921,10 +930,7 @@
       block_res_arrs = blockResArrs slug
 
   old_counter <- dPrim "old_counter"
-  (counter_mem, _, counter_offset) <-
-    fullyIndexArray
-      counters
-      [counter_idx]
+  (counter_mem, _, counter_offset) <- fullyIndexArray counters [counter_idx]
   sComment "first thread in block saves block result to global memory" $
     sWhen (ltid32 .==. 0) $ do
       forM_ (take (length nes) $ zip block_res_arrs (slugAccs slug)) $ \(v, (acc, acc_is)) ->
diff --git a/src/Futhark/CodeGen/ImpGen/Multicore.hs b/src/Futhark/CodeGen/ImpGen/Multicore.hs
--- a/src/Futhark/CodeGen/ImpGen/Multicore.hs
+++ b/src/Futhark/CodeGen/ImpGen/Multicore.hs
@@ -164,11 +164,11 @@
   SegOp () MCMem ->
   TV Int32 ->
   ImpM MCMem HostEnv Imp.Multicore Imp.MCCode
-compileSegOp pat (SegHist _ space histops _ kbody) ntasks =
+compileSegOp pat (SegHist _ space _ kbody histops) ntasks =
   compileSegHist pat space histops kbody ntasks
-compileSegOp pat (SegScan _ space scans _ kbody) ntasks =
+compileSegOp pat (SegScan _ space _ kbody scans) ntasks =
   compileSegScan pat space scans kbody ntasks
-compileSegOp pat (SegRed _ space reds _ kbody) ntasks =
+compileSegOp pat (SegRed _ space _ kbody reds) ntasks =
   compileSegRed pat space reds kbody ntasks
 compileSegOp pat (SegMap _ space _ kbody) _ =
   compileSegMap pat space kbody
diff --git a/src/Futhark/IR/Parse.hs b/src/Futhark/IR/Parse.hs
--- a/src/Futhark/IR/Parse.hs
+++ b/src/Futhark/IR/Parse.hs
@@ -919,18 +919,10 @@
       keyword "seghist" *> pSegHist
     ]
   where
-    pSegMap =
-      SegOp.SegMap
-        <$> pLvl
-        <*> pSegSpace
-        <* pColon
-        <*> pTypes
-        <*> braces (pKernelBody pr)
-    pSegOp' f p =
+    pSegOp' f =
       f
         <$> pLvl
         <*> pSegSpace
-        <*> parens (p `sepBy` pComma)
         <* pColon
         <*> pTypes
         <*> braces (pKernelBody pr)
@@ -953,9 +945,10 @@
         <*> pShape
         <* pComma
         <*> pLambda pr
-    pSegRed = pSegOp' SegOp.SegRed pSegBinOp
-    pSegScan = pSegOp' SegOp.SegScan pSegBinOp
-    pSegHist = pSegOp' SegOp.SegHist pHistOp
+    pSegMap = pSegOp' SegOp.SegMap
+    pSegRed = pSegOp' SegOp.SegRed <*> parens (pSegBinOp `sepBy` pComma)
+    pSegScan = pSegOp' SegOp.SegScan <*> parens (pSegBinOp `sepBy` pComma)
+    pSegHist = pSegOp' SegOp.SegHist <*> parens (pHistOp `sepBy` pComma)
 
 pSegLevel :: Parser GPU.SegLevel
 pSegLevel =
diff --git a/src/Futhark/IR/SegOp.hs b/src/Futhark/IR/SegOp.hs
--- a/src/Futhark/IR/SegOp.hs
+++ b/src/Futhark/IR/SegOp.hs
@@ -450,9 +450,9 @@
   = SegMap lvl SegSpace [Type] (KernelBody rep)
   | -- | The KernelSpace must always have at least two dimensions,
     -- implying that the result of a SegRed is always an array.
-    SegRed lvl SegSpace [SegBinOp rep] [Type] (KernelBody rep)
-  | SegScan lvl SegSpace [SegBinOp rep] [Type] (KernelBody rep)
-  | SegHist lvl SegSpace [HistOp rep] [Type] (KernelBody rep)
+    SegRed lvl SegSpace [Type] (KernelBody rep) [SegBinOp rep]
+  | SegScan lvl SegSpace [Type] (KernelBody rep) [SegBinOp rep]
+  | SegHist lvl SegSpace [Type] (KernelBody rep) [HistOp rep]
   deriving (Eq, Ord, Show)
 
 -- | The level of a 'SegOp'.
@@ -474,9 +474,9 @@
 segBody segop =
   case segop of
     SegMap _ _ _ body -> body
-    SegRed _ _ _ _ body -> body
-    SegScan _ _ _ _ body -> body
-    SegHist _ _ _ _ body -> body
+    SegRed _ _ _ body _ -> body
+    SegScan _ _ _ body _ -> body
+    SegHist _ _ _ body _ -> body
 
 segResultShape :: SegSpace -> Type -> KernelResult -> Type
 segResultShape _ t (WriteReturns {}) =
@@ -492,7 +492,7 @@
 segOpType :: SegOp lvl rep -> [Type]
 segOpType (SegMap _ space ts kbody) =
   zipWith (segResultShape space) ts $ kernelBodyResult kbody
-segOpType (SegRed _ space reds ts kbody) =
+segOpType (SegRed _ space ts kbody reds) =
   red_ts
     ++ zipWith
       (segResultShape space)
@@ -505,7 +505,7 @@
       op <- reds
       let shape = Shape segment_dims <> segBinOpShape op
       map (`arrayOfShape` shape) (lambdaReturnType $ segBinOpLambda op)
-segOpType (SegScan _ space scans ts kbody) =
+segOpType (SegScan _ space ts kbody scans) =
   scan_ts
     ++ zipWith
       (segResultShape space)
@@ -517,7 +517,7 @@
       op <- scans
       let shape = Shape (segSpaceDims space) <> segBinOpShape op
       map (`arrayOfShape` shape) (lambdaReturnType $ segBinOpLambda op)
-segOpType (SegHist _ space ops _ _) = do
+segOpType (SegHist _ space _ _ ops) = do
   op <- ops
   let shape = Shape segment_dims <> histShape op <> histOpShape op
   map (`arrayOfShape` shape) (lambdaReturnType $ histOp op)
@@ -533,11 +533,11 @@
 
   consumedInOp (SegMap _ _ _ kbody) =
     consumedInKernelBody kbody
-  consumedInOp (SegRed _ _ _ _ kbody) =
+  consumedInOp (SegRed _ _ _ kbody _) =
     consumedInKernelBody kbody
-  consumedInOp (SegScan _ _ _ _ kbody) =
+  consumedInOp (SegScan _ _ _ kbody _) =
     consumedInKernelBody kbody
-  consumedInOp (SegHist _ _ ops _ kbody) =
+  consumedInOp (SegHist _ _ _ kbody ops) =
     namesFromList (concatMap histDest ops) <> consumedInKernelBody kbody
 
 -- | Type check a 'SegOp', given a checker for its level.
@@ -549,7 +549,7 @@
 typeCheckSegOp checkLvl (SegMap lvl space ts kbody) = do
   checkLvl lvl
   checkScanRed space [] ts kbody
-typeCheckSegOp checkLvl (SegRed lvl space reds ts body) = do
+typeCheckSegOp checkLvl (SegRed lvl space ts body reds) = do
   checkLvl lvl
   checkScanRed space reds' ts body
   where
@@ -558,7 +558,7 @@
         (map segBinOpLambda reds)
         (map segBinOpNeutral reds)
         (map segBinOpShape reds)
-typeCheckSegOp checkLvl (SegScan lvl space scans ts body) = do
+typeCheckSegOp checkLvl (SegScan lvl space ts body scans) = do
   checkLvl lvl
   checkScanRed space scans' ts body
   where
@@ -567,7 +567,7 @@
         (map segBinOpLambda scans)
         (map segBinOpNeutral scans)
         (map segBinOpShape scans)
-typeCheckSegOp checkLvl (SegHist lvl space ops ts kbody) = do
+typeCheckSegOp checkLvl (SegHist lvl space ts kbody ops) = do
   checkLvl lvl
   checkSegSpace space
   mapM_ TC.checkType ts
@@ -705,27 +705,27 @@
     <*> mapOnSegSpace tv space
     <*> mapM (mapOnSegOpType tv) ts
     <*> mapOnSegOpBody tv body
-mapSegOpM tv (SegRed lvl space reds ts lam) =
+mapSegOpM tv (SegRed lvl space ts body reds) =
   SegRed
     <$> mapOnSegOpLevel tv lvl
     <*> mapOnSegSpace tv space
-    <*> mapM (mapSegBinOp tv) reds
     <*> mapM (mapOnType $ mapOnSegOpSubExp tv) ts
-    <*> mapOnSegOpBody tv lam
-mapSegOpM tv (SegScan lvl space scans ts body) =
+    <*> mapOnSegOpBody tv body
+    <*> mapM (mapSegBinOp tv) reds
+mapSegOpM tv (SegScan lvl space ts body scans) =
   SegScan
     <$> mapOnSegOpLevel tv lvl
     <*> mapOnSegSpace tv space
-    <*> mapM (mapSegBinOp tv) scans
     <*> mapM (mapOnType $ mapOnSegOpSubExp tv) ts
     <*> mapOnSegOpBody tv body
-mapSegOpM tv (SegHist lvl space ops ts body) =
+    <*> mapM (mapSegBinOp tv) scans
+mapSegOpM tv (SegHist lvl space ts body ops) =
   SegHist
     <$> mapOnSegOpLevel tv lvl
     <*> mapOnSegSpace tv space
-    <*> mapM onHistOp ops
     <*> mapM (mapOnType $ mapOnSegOpSubExp tv) ts
     <*> mapOnSegOpBody tv body
+    <*> mapM onHistOp ops
   where
     onHistOp (HistOp w rf arrs nes shape op) =
       HistOp
@@ -771,21 +771,18 @@
 instance RephraseOp (SegOp lvl) where
   rephraseInOp r (SegMap lvl space ts body) =
     SegMap lvl space ts <$> rephraseKernelBody r body
-  rephraseInOp r (SegRed lvl space reds ts body) =
-    SegRed lvl space
-      <$> mapM (rephraseBinOp r) reds
-      <*> pure ts
-      <*> rephraseKernelBody r body
-  rephraseInOp r (SegScan lvl space scans ts body) =
-    SegScan lvl space
-      <$> mapM (rephraseBinOp r) scans
-      <*> pure ts
-      <*> rephraseKernelBody r body
-  rephraseInOp r (SegHist lvl space hists ts body) =
-    SegHist lvl space
-      <$> mapM onOp hists
-      <*> pure ts
-      <*> rephraseKernelBody r body
+  rephraseInOp r (SegRed lvl space ts body reds) =
+    SegRed lvl space ts
+      <$> rephraseKernelBody r body
+      <*> mapM (rephraseBinOp r) reds
+  rephraseInOp r (SegScan lvl space ts body scans) =
+    SegScan lvl space ts
+      <$> rephraseKernelBody r body
+      <*> mapM (rephraseBinOp r) scans
+  rephraseInOp r (SegHist lvl space ts body hists) =
+    SegHist lvl space ts
+      <$> rephraseKernelBody r body
+      <*> mapM onOp hists
     where
       onOp (HistOp w rf arrs nes shape op) =
         HistOp w rf arrs nes shape <$> rephraseLambda r op
@@ -844,15 +841,15 @@
 instance (OpMetrics (Op rep)) => OpMetrics (SegOp lvl rep) where
   opMetrics (SegMap _ _ _ body) =
     inside "SegMap" $ kernelBodyMetrics body
-  opMetrics (SegRed _ _ reds _ body) =
+  opMetrics (SegRed _ _ _ body reds) =
     inside "SegRed" $ do
       mapM_ (inside "SegBinOp" . lambdaMetrics . segBinOpLambda) reds
       kernelBodyMetrics body
-  opMetrics (SegScan _ _ scans _ body) =
+  opMetrics (SegScan _ _ _ body scans) =
     inside "SegScan" $ do
       mapM_ (inside "SegBinOp" . lambdaMetrics . segBinOpLambda) scans
       kernelBodyMetrics body
-  opMetrics (SegHist _ _ ops _ body) =
+  opMetrics (SegHist _ _ _ body ops) =
     inside "SegHist" $ do
       mapM_ (lambdaMetrics . histOp) ops
       kernelBodyMetrics body
@@ -887,30 +884,30 @@
         <+> PP.colon
         <+> ppTuple' (map pretty ts)
         <+> PP.nestedBlock "{" "}" (pretty body)
-  pretty (SegRed lvl space reds ts body) =
+  pretty (SegRed lvl space ts body reds) =
     "segred"
       <> pretty lvl
         </> PP.align (pretty space)
-        </> PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty reds)
         </> PP.colon
         <+> ppTuple' (map pretty ts)
         <+> PP.nestedBlock "{" "}" (pretty body)
-  pretty (SegScan lvl space scans ts body) =
+        </> PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty reds)
+  pretty (SegScan lvl space ts body scans) =
     "segscan"
       <> pretty lvl
         </> PP.align (pretty space)
-        </> PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty scans)
         </> PP.colon
         <+> ppTuple' (map pretty ts)
         <+> PP.nestedBlock "{" "}" (pretty body)
-  pretty (SegHist lvl space ops ts body) =
+        </> PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty scans)
+  pretty (SegHist lvl space ts body ops) =
     "seghist"
       <> pretty lvl
         </> PP.align (pretty space)
-        </> PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map ppOp ops)
         </> PP.colon
         <+> ppTuple' (map pretty ts)
         <+> PP.nestedBlock "{" "}" (pretty body)
+        </> PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map ppOp ops)
     where
       ppOp (HistOp w rf dests nes shape op) =
         pretty w
@@ -1125,7 +1122,7 @@
     ( SegMap lvl' space' ts' kbody',
       body_hoisted
     )
-simplifySegOp (SegRed lvl space reds ts kbody) = do
+simplifySegOp (SegRed lvl space ts kbody reds) = do
   (lvl', space', ts') <- Engine.simplify (lvl, space, ts)
   (reds', reds_hoisted) <-
     Engine.localVtable (<> scope_vtable) $
@@ -1133,13 +1130,13 @@
   (kbody', body_hoisted) <- simplifyKernelBody space kbody
 
   pure
-    ( SegRed lvl' space' reds' ts' kbody',
+    ( SegRed lvl' space' ts' kbody' reds',
       mconcat reds_hoisted <> body_hoisted
     )
   where
     scope = scopeOfSegSpace space
     scope_vtable = ST.fromScope scope
-simplifySegOp (SegScan lvl space scans ts kbody) = do
+simplifySegOp (SegScan lvl space ts kbody scans) = do
   (lvl', space', ts') <- Engine.simplify (lvl, space, ts)
   (scans', scans_hoisted) <-
     Engine.localVtable (<> scope_vtable) $
@@ -1147,13 +1144,13 @@
   (kbody', body_hoisted) <- simplifyKernelBody space kbody
 
   pure
-    ( SegScan lvl' space' scans' ts' kbody',
+    ( SegScan lvl' space' ts' kbody' scans',
       mconcat scans_hoisted <> body_hoisted
     )
   where
     scope = scopeOfSegSpace space
     scope_vtable = ST.fromScope scope
-simplifySegOp (SegHist lvl space ops ts kbody) = do
+simplifySegOp (SegHist lvl space ts kbody ops) = do
   (lvl', space', ts') <- Engine.simplify (lvl, space, ts)
 
   Engine.localVtable (flip (foldr ST.consume) $ concatMap histDest ops) $ do
@@ -1176,7 +1173,7 @@
     (kbody', body_hoisted) <- simplifyKernelBody space kbody
 
     pure
-      ( SegHist lvl' space' ops' ts' kbody',
+      ( SegHist lvl' space' ts' kbody' ops',
         mconcat ops_hoisted <> body_hoisted
       )
   where
@@ -1251,7 +1248,7 @@
 -- If a SegRed contains two reduction operations that have the same
 -- vector shape, merge them together.  This saves on communication
 -- overhead, but can in principle lead to more shared memory usage.
-topDownSegOp _ (Pat pes) _ (SegRed lvl space ops ts kbody)
+topDownSegOp _ (Pat pes) _ (SegRed lvl space ts kbody ops)
   | length ops > 1,
     op_groupings <-
       groupBy sameShape $
@@ -1264,7 +1261,7 @@
           pes' = red_pes' ++ map_pes
           ts' = red_ts' ++ map_ts
           kbody' = kbody {kernelBodyResult = red_res' ++ map_res}
-      letBind (Pat pes') $ Op $ segOp $ SegRed lvl space ops' ts' kbody'
+      letBind (Pat pes') $ Op $ segOp $ SegRed lvl space ts' kbody' ops'
   where
     (red_pes, map_pes) = splitAt (segBinOpResults ops) pes
     (red_ts, map_ts) = splitAt (segBinOpResults ops) ts
@@ -1317,12 +1314,12 @@
   )
 segOpGuts (SegMap lvl space kts body) =
   (kts, body, 0, SegMap lvl space)
-segOpGuts (SegScan lvl space ops kts body) =
-  (kts, body, segBinOpResults ops, SegScan lvl space ops)
-segOpGuts (SegRed lvl space ops kts body) =
-  (kts, body, segBinOpResults ops, SegRed lvl space ops)
-segOpGuts (SegHist lvl space ops kts body) =
-  (kts, body, sum $ map (length . histDest) ops, SegHist lvl space ops)
+segOpGuts (SegScan lvl space kts body ops) =
+  (kts, body, segBinOpResults ops, \t b -> SegScan lvl space t b ops)
+segOpGuts (SegRed lvl space kts body ops) =
+  (kts, body, segBinOpResults ops, \t b -> SegRed lvl space t b ops)
+segOpGuts (SegHist lvl space kts body ops) =
+  (kts, body, sum $ map (length . histDest) ops, \t b -> SegHist lvl space t b ops)
 
 bottomUpSegOp ::
   (Aliased rep, HasSegOp rep, BuilderOps rep) =>
@@ -1441,9 +1438,9 @@
   m [ExpReturns]
 segOpReturns k@(SegMap _ _ _ kbody) =
   kernelBodyReturns kbody . extReturns =<< opType k
-segOpReturns k@(SegRed _ _ _ _ kbody) =
+segOpReturns k@(SegRed _ _ _ kbody _) =
   kernelBodyReturns kbody . extReturns =<< opType k
-segOpReturns k@(SegScan _ _ _ _ kbody) =
+segOpReturns k@(SegScan _ _ _ kbody _) =
   kernelBodyReturns kbody . extReturns =<< opType k
-segOpReturns (SegHist _ _ ops _ _) =
+segOpReturns (SegHist _ _ _ _ ops) =
   concat <$> mapM (mapM varReturns . histDest) ops
diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs
--- a/src/Futhark/Internalise/Exps.hs
+++ b/src/Futhark/Internalise/Exps.hs
@@ -50,7 +50,15 @@
   bindingFParams tparams params $ \shapeparams params' -> do
     let shapenames = map I.paramName shapeparams
         all_params = map pure shapeparams ++ concat params'
-        msg = errorMsg ["Function return value does not match shape of declared return type."]
+        msg =
+          errorMsg
+            [ "Internal runtime error.\n",
+              "Return value of ",
+              ErrorString (prettyText fname),
+              " does not match type shape.\n",
+              "This is a bug in the Futhark compiler. Please report this:\n",
+              "  https://github.com/diku-dk/futhark/issues"
+            ]
 
     (body', rettype') <- buildBody $ do
       body_res <- internaliseExp (baseString fname <> "_res") body
diff --git a/src/Futhark/Internalise/Monomorphise.hs b/src/Futhark/Internalise/Monomorphise.hs
--- a/src/Futhark/Internalise/Monomorphise.hs
+++ b/src/Futhark/Internalise/Monomorphise.hs
@@ -829,15 +829,27 @@
       onExps bound e1 e2
       pure e1
 
-    onExps bound (Var v _ _) e = do
-      unless (any (`elem` bound) $ freeVarsInExp e) $
-        modify (M.insert (qualLeaf v) e)
-      case lookup (qualLeaf v) named1 of
-        Just rexp -> onExps bound (unReplaced rexp) e
-        Nothing -> pure ()
-    onExps bound e (Var v _ _)
+    -- XXX: It is intentional that we throw away the 'bound'
+    -- information after looking up ExpReplacements, as there are
+    -- cases (particularly including the function types that occur
+    -- after lambda lifting) where some troublesome shadowing occurs,
+    -- and the names are not actually locally bound. We cannot just
+    -- ignore the bound information entirely, and expect that any
+    -- instantiation uses only names in scope at the outer level, due
+    -- to truly exotic cases like entry-lifted.fut, where the real
+    -- sizes were not visible to the type checker. Arguably that is
+    -- the thing that should be fixed, but it requires fiddling with
+    -- the defunctorisation of size-lifted types.
+
+    onExps bound (Var v _ _) e
+      | Just rexp <- lookup (qualLeaf v) named1 =
+          onExps mempty (unReplaced rexp) e
+      | otherwise =
+          unless (any (`elem` bound) $ freeVarsInExp e) $
+            modify (M.insert (qualLeaf v) e)
+    onExps _bound e (Var v _ _)
       | Just rexp <- lookup (qualLeaf v) named2 =
-          onExps bound e (unReplaced rexp)
+          onExps mempty e (unReplaced rexp)
     onExps bound e1 e2
       | Just es <- similarExps e1 e2 =
           mapM_ (uncurry $ onExps bound) es
diff --git a/src/Futhark/Optimise/ArrayShortCircuiting.hs b/src/Futhark/Optimise/ArrayShortCircuiting.hs
--- a/src/Futhark/Optimise/ArrayShortCircuiting.hs
+++ b/src/Futhark/Optimise/ArrayShortCircuiting.hs
@@ -166,15 +166,15 @@
 replaceInSegOp (SegMap lvl sp tps body) = do
   stms <- updateStms $ kernelBodyStms body
   pure $ SegMap lvl sp tps $ body {kernelBodyStms = stms}
-replaceInSegOp (SegRed lvl sp binops tps body) = do
+replaceInSegOp (SegRed lvl sp tps body binops) = do
   stms <- updateStms $ kernelBodyStms body
-  pure $ SegRed lvl sp binops tps $ body {kernelBodyStms = stms}
-replaceInSegOp (SegScan lvl sp binops tps body) = do
+  pure $ SegRed lvl sp tps (body {kernelBodyStms = stms}) binops
+replaceInSegOp (SegScan lvl sp tps body binops) = do
   stms <- updateStms $ kernelBodyStms body
-  pure $ SegScan lvl sp binops tps $ body {kernelBodyStms = stms}
-replaceInSegOp (SegHist lvl sp hist_ops tps body) = do
+  pure $ SegScan lvl sp tps (body {kernelBodyStms = stms}) binops
+replaceInSegOp (SegHist lvl sp tps body hist_ops) = do
   stms <- updateStms $ kernelBodyStms body
-  pure $ SegHist lvl sp hist_ops tps $ body {kernelBodyStms = stms}
+  pure $ SegHist lvl sp tps (body {kernelBodyStms = stms}) hist_ops
 
 replaceInHostOp :: HostOp NoOp GPUMem -> UpdateM (HostOp NoOp GPUMem) (HostOp NoOp GPUMem)
 replaceInHostOp (SegOp op) = SegOp <$> replaceInSegOp op
diff --git a/src/Futhark/Optimise/ArrayShortCircuiting/ArrayCoalescing.hs b/src/Futhark/Optimise/ArrayShortCircuiting/ArrayCoalescing.hs
--- a/src/Futhark/Optimise/ArrayShortCircuiting/ArrayCoalescing.hs
+++ b/src/Futhark/Optimise/ArrayShortCircuiting/ArrayCoalescing.hs
@@ -201,7 +201,7 @@
 shortCircuitSegOp lvlOK lutab pat pat_certs (SegMap lvl space _ kernel_body) td_env bu_env =
   -- No special handling necessary for 'SegMap'. Just call the helper-function.
   shortCircuitSegOpHelper 0 lvlOK lvl lutab pat pat_certs space kernel_body td_env bu_env
-shortCircuitSegOp lvlOK lutab pat pat_certs (SegRed lvl space binops _ kernel_body) td_env bu_env =
+shortCircuitSegOp lvlOK lutab pat pat_certs (SegRed lvl space _ kernel_body binops) td_env bu_env =
   -- When handling 'SegRed', we we first invalidate all active coalesce-entries
   -- where any of the variables in 'vartab' are also free in the list of
   -- 'SegBinOp'. In other words, anything that is used as part of the reduction
@@ -218,14 +218,14 @@
       op <- binops
       let shp = Shape segment_dims <> segBinOpShape op
       map (`arrayOfShape` shp) (lambdaReturnType $ segBinOpLambda op)
-shortCircuitSegOp lvlOK lutab pat pat_certs (SegScan lvl space binops _ kernel_body) td_env bu_env =
+shortCircuitSegOp lvlOK lutab pat pat_certs (SegScan lvl space _ kernel_body binops) td_env bu_env =
   -- Like in the handling of 'SegRed', we do not want to coalesce anything that
   -- is used in the 'SegBinOp'
   let to_fail = M.filter (\entry -> namesFromList (M.keys $ vartab entry) `namesIntersect` foldMap (freeIn . segBinOpLambda) binops) $ activeCoals bu_env
       (active, inh) = foldl markFailedCoal (activeCoals bu_env, inhibit bu_env) $ M.keys to_fail
       bu_env' = bu_env {activeCoals = active, inhibit = inh}
    in shortCircuitSegOpHelper 0 lvlOK lvl lutab pat pat_certs space kernel_body td_env bu_env'
-shortCircuitSegOp lvlOK lutab pat pat_certs (SegHist lvl space histops _ kernel_body) td_env bu_env = do
+shortCircuitSegOp lvlOK lutab pat pat_certs (SegHist lvl space _ kernel_body histops) td_env bu_env = do
   -- Need to take zipped patterns and histDest (flattened) and insert transitive coalesces
   let to_fail = M.filter (\entry -> namesFromList (M.keys $ vartab entry) `namesIntersect` foldMap (freeIn . histOp) histops) $ activeCoals bu_env
       (active, inh) = foldl markFailedCoal (activeCoals bu_env, inhibit bu_env) $ M.keys to_fail
diff --git a/src/Futhark/Optimise/HistAccs.hs b/src/Futhark/Optimise/HistAccs.hs
--- a/src/Futhark/Optimise/HistAccs.hs
+++ b/src/Futhark/Optimise/HistAccs.hs
@@ -146,7 +146,7 @@
       (space', kbody'') <- flatKernelBody space kbody'
 
       hist_dest_upd <-
-        letTupExp "hist_dest_upd" $ Op $ SegOp $ SegHist lvl space' [histop] ts' kbody''
+        letTupExp "hist_dest_upd" $ Op $ SegOp $ SegHist lvl space' ts' kbody'' [histop]
 
       addStm . Let pat aux =<< addArrsToAcc lvl acc_shape hist_dest_upd acc
 optimiseStm accs (Let pat aux e) =
diff --git a/src/Futhark/Optimise/MemoryBlockMerging.hs b/src/Futhark/Optimise/MemoryBlockMerging.hs
--- a/src/Futhark/Optimise/MemoryBlockMerging.hs
+++ b/src/Futhark/Optimise/MemoryBlockMerging.hs
@@ -37,11 +37,11 @@
 getAllocsSegOp :: SegOp lvl GPUMem -> Allocs
 getAllocsSegOp (SegMap _ _ _ body) =
   foldMap getAllocsStm (kernelBodyStms body)
-getAllocsSegOp (SegRed _ _ _ _ body) =
+getAllocsSegOp (SegRed _ _ _ body _) =
   foldMap getAllocsStm (kernelBodyStms body)
-getAllocsSegOp (SegScan _ _ _ _ body) =
+getAllocsSegOp (SegScan _ _ _ body _) =
   foldMap getAllocsStm (kernelBodyStms body)
-getAllocsSegOp (SegHist _ _ _ _ body) =
+getAllocsSegOp (SegHist _ _ _ body _) =
   foldMap getAllocsStm (kernelBodyStms body)
 
 setAllocsStm :: Map VName SubExp -> Stm GPUMem -> Stm GPUMem
@@ -69,15 +69,18 @@
 setAllocsSegOp m (SegMap lvl sp tps body) =
   SegMap lvl sp tps $
     body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
-setAllocsSegOp m (SegRed lvl sp segbinops tps body) =
-  SegRed lvl sp segbinops tps $
-    body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
-setAllocsSegOp m (SegScan lvl sp segbinops tps body) =
-  SegScan lvl sp segbinops tps $
-    body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
-setAllocsSegOp m (SegHist lvl sp segbinops tps body) =
-  SegHist lvl sp segbinops tps $
-    body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
+setAllocsSegOp m (SegRed lvl sp tps body ops) =
+  SegRed lvl sp tps body' ops
+  where
+    body' = body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
+setAllocsSegOp m (SegScan lvl sp tps body ops) =
+  SegScan lvl sp tps body' ops
+  where
+    body' = body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
+setAllocsSegOp m (SegHist lvl sp tps body ops) =
+  SegHist lvl sp tps body' ops
+  where
+    body' = body {kernelBodyStms = setAllocsStm m <$> kernelBodyStms body}
 
 maxSubExp :: (MonadBuilder m) => Set SubExp -> m SubExp
 maxSubExp = helper . S.toList
@@ -105,15 +108,15 @@
 onKernelBodyStms (SegMap lvl space ts body) f = do
   stms <- f $ kernelBodyStms body
   pure $ SegMap lvl space ts $ body {kernelBodyStms = stms}
-onKernelBodyStms (SegRed lvl space binops ts body) f = do
+onKernelBodyStms (SegRed lvl space ts body binops) f = do
   stms <- f $ kernelBodyStms body
-  pure $ SegRed lvl space binops ts $ body {kernelBodyStms = stms}
-onKernelBodyStms (SegScan lvl space binops ts body) f = do
+  pure $ SegRed lvl space ts (body {kernelBodyStms = stms}) binops
+onKernelBodyStms (SegScan lvl space ts body binops) f = do
   stms <- f $ kernelBodyStms body
-  pure $ SegScan lvl space binops ts $ body {kernelBodyStms = stms}
-onKernelBodyStms (SegHist lvl space binops ts body) f = do
+  pure $ SegScan lvl space ts (body {kernelBodyStms = stms}) binops
+onKernelBodyStms (SegHist lvl space ts body binops) f = do
   stms <- f $ kernelBodyStms body
-  pure $ SegHist lvl space binops ts $ body {kernelBodyStms = stms}
+  pure $ SegHist lvl space ts (body {kernelBodyStms = stms}) binops
 
 -- | This is the actual optimiser. Given an interference graph and a @SegOp@,
 -- replace allocations and references to memory blocks inside with a (hopefully)
@@ -148,15 +151,18 @@
     SegMap lvl sp tps body ->
       SegMap lvl sp tps $
         body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
-    SegRed lvl sp binops tps body ->
-      SegRed lvl sp binops tps $
-        body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
-    SegScan lvl sp binops tps body ->
-      SegScan lvl sp binops tps $
-        body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
-    SegHist lvl sp binops tps body ->
-      SegHist lvl sp binops tps $
-        body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
+    SegRed lvl sp tps body ops ->
+      SegRed lvl sp tps body' ops
+      where
+        body' = body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
+    SegScan lvl sp tps body ops ->
+      SegScan lvl sp tps body' ops
+      where
+        body' = body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
+    SegHist lvl sp tps body ops ->
+      SegHist lvl sp tps body' ops
+      where
+        body' = body {kernelBodyStms = maxstms <> stms <> kernelBodyStms body}
 
 -- | Helper function that modifies kernels found inside some statements.
 onKernels ::
diff --git a/src/Futhark/Optimise/ReduceDeviceSyncs.hs b/src/Futhark/Optimise/ReduceDeviceSyncs.hs
--- a/src/Futhark/Optimise/ReduceDeviceSyncs.hs
+++ b/src/Futhark/Optimise/ReduceDeviceSyncs.hs
@@ -328,15 +328,18 @@
 optimizeHostOp :: HostOp op GPU -> ReduceM (HostOp op GPU)
 optimizeHostOp (SegOp (SegMap lvl space types kbody)) =
   SegOp . SegMap lvl space types <$> addReadsToKernelBody kbody
-optimizeHostOp (SegOp (SegRed lvl space ops types kbody)) = do
+optimizeHostOp (SegOp (SegRed lvl space types kbody ops)) = do
   ops' <- mapM addReadsToSegBinOp ops
-  SegOp . SegRed lvl space ops' types <$> addReadsToKernelBody kbody
-optimizeHostOp (SegOp (SegScan lvl space ops types kbody)) = do
+  kbody' <- addReadsToKernelBody kbody
+  pure . SegOp $ SegRed lvl space types kbody' ops'
+optimizeHostOp (SegOp (SegScan lvl space types kbody ops)) = do
   ops' <- mapM addReadsToSegBinOp ops
-  SegOp . SegScan lvl space ops' types <$> addReadsToKernelBody kbody
-optimizeHostOp (SegOp (SegHist lvl space ops types kbody)) = do
+  kbody' <- addReadsToKernelBody kbody
+  pure . SegOp $ SegScan lvl space types kbody' ops'
+optimizeHostOp (SegOp (SegHist lvl space types kbody ops)) = do
   ops' <- mapM addReadsToHistOp ops
-  SegOp . SegHist lvl space ops' types <$> addReadsToKernelBody kbody
+  kbody' <- addReadsToKernelBody kbody
+  pure . SegOp $ SegHist lvl space types kbody' ops'
 optimizeHostOp (SizeOp op) =
   pure (SizeOp op)
 optimizeHostOp OtherOp {} =
diff --git a/src/Futhark/Optimise/ReduceDeviceSyncs/MigrationTable.hs b/src/Futhark/Optimise/ReduceDeviceSyncs/MigrationTable.hs
--- a/src/Futhark/Optimise/ReduceDeviceSyncs/MigrationTable.hs
+++ b/src/Futhark/Optimise/ReduceDeviceSyncs/MigrationTable.hs
@@ -1074,15 +1074,15 @@
     collectHostOp (SegOp (SegMap lvl sp _ _)) = do
       collectSegLevel lvl
       collectSegSpace sp
-    collectHostOp (SegOp (SegRed lvl sp ops _ _)) = do
+    collectHostOp (SegOp (SegRed lvl sp _ _ ops)) = do
       collectSegLevel lvl
       collectSegSpace sp
       mapM_ collectSegBinOp ops
-    collectHostOp (SegOp (SegScan lvl sp ops _ _)) = do
+    collectHostOp (SegOp (SegScan lvl sp _ _ ops)) = do
       collectSegLevel lvl
       collectSegSpace sp
       mapM_ collectSegBinOp ops
-    collectHostOp (SegOp (SegHist lvl sp ops _ _)) = do
+    collectHostOp (SegOp (SegHist lvl sp _ _ ops)) = do
       collectSegLevel lvl
       collectSegSpace sp
       mapM_ collectHistOp ops
diff --git a/src/Futhark/Pass/ExpandAllocations.hs b/src/Futhark/Pass/ExpandAllocations.hs
--- a/src/Futhark/Pass/ExpandAllocations.hs
+++ b/src/Futhark/Pass/ExpandAllocations.hs
@@ -117,28 +117,28 @@
     ( alloc_stms,
       Op $ Inner $ SegOp $ SegMap lvl' space ts kbody'
     )
-transformExp (Op (Inner (SegOp (SegRed lvl space reds ts kbody)))) = do
+transformExp (Op (Inner (SegOp (SegRed lvl space ts kbody reds)))) = do
   (alloc_stms, (lvl', lams, kbody')) <-
     transformScanRed lvl space (map segBinOpLambda reds) kbody
   let reds' = zipWith (\red lam -> red {segBinOpLambda = lam}) reds lams
   pure
     ( alloc_stms,
-      Op $ Inner $ SegOp $ SegRed lvl' space reds' ts kbody'
+      Op $ Inner $ SegOp $ SegRed lvl' space ts kbody' reds'
     )
-transformExp (Op (Inner (SegOp (SegScan lvl space scans ts kbody)))) = do
+transformExp (Op (Inner (SegOp (SegScan lvl space ts kbody scans)))) = do
   (alloc_stms, (lvl', lams, kbody')) <-
     transformScanRed lvl space (map segBinOpLambda scans) kbody
   let scans' = zipWith (\red lam -> red {segBinOpLambda = lam}) scans lams
   pure
     ( alloc_stms,
-      Op $ Inner $ SegOp $ SegScan lvl' space scans' ts kbody'
+      Op $ Inner $ SegOp $ SegScan lvl' space ts kbody' scans'
     )
-transformExp (Op (Inner (SegOp (SegHist lvl space ops ts kbody)))) = do
+transformExp (Op (Inner (SegOp (SegHist lvl space ts kbody ops)))) = do
   (alloc_stms, (lvl', lams', kbody')) <- transformScanRed lvl space lams kbody
   let ops' = zipWith onOp ops lams'
   pure
     ( alloc_stms,
-      Op $ Inner $ SegOp $ SegHist lvl' space ops' ts kbody'
+      Op $ Inner $ SegOp $ SegHist lvl' space ts kbody' ops'
     )
   where
     lams = map histOp ops
diff --git a/src/Futhark/Pass/ExplicitAllocations/GPU.hs b/src/Futhark/Pass/ExplicitAllocations/GPU.hs
--- a/src/Futhark/Pass/ExplicitAllocations/GPU.hs
+++ b/src/Futhark/Pass/ExplicitAllocations/GPU.hs
@@ -105,7 +105,7 @@
   pure [Hint lmad $ Space "device"]
 kernelExpHints (Op (Inner (SegOp (SegMap lvl@(SegThread _ _) space ts body)))) =
   zipWithM (mapResultHint lvl space) ts $ kernelBodyResult body
-kernelExpHints (Op (Inner (SegOp (SegRed lvl@(SegThread _ _) space reds ts body)))) =
+kernelExpHints (Op (Inner (SegOp (SegRed lvl@(SegThread _ _) space ts body reds)))) =
   (map (const NoHint) red_res <>) <$> zipWithM (mapResultHint lvl space) (drop num_reds ts) map_res
   where
     num_reds = segBinOpResults reds
diff --git a/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs b/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs
--- a/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs
+++ b/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs
@@ -88,7 +88,7 @@
   letBind pat $
     Op $
       segOp $
-        SegRed lvl kspace ops (lambdaReturnType map_lam) kbody
+        SegRed lvl kspace (lambdaReturnType map_lam) kbody ops
 
 segScan ::
   (MonadFreshNames m, DistRep rep, HasScope rep m) =>
@@ -107,7 +107,7 @@
   letBind pat $
     Op $
       segOp $
-        SegScan lvl kspace ops (lambdaReturnType map_lam) kbody
+        SegScan lvl kspace (lambdaReturnType map_lam) kbody ops
 
 segMap ::
   (MonadFreshNames m, DistRep rep, HasScope rep m) =>
@@ -197,7 +197,7 @@
         forM res $ \(SubExpRes cs se) ->
           pure $ Returns ResultMaySimplify cs se
 
-  letBind pat $ Op $ segOp $ SegHist lvl space ops (lambdaReturnType lam) kbody
+  letBind pat $ Op $ segOp $ SegHist lvl space (lambdaReturnType lam) kbody ops
 
 mapKernelSkeleton ::
   (DistRep rep, HasScope rep m, MonadFreshNames m) =>
diff --git a/src/Futhark/Pass/ExtractKernels/DistributeNests.hs b/src/Futhark/Pass/ExtractKernels/DistributeNests.hs
--- a/src/Futhark/Pass/ExtractKernels/DistributeNests.hs
+++ b/src/Futhark/Pass/ExtractKernels/DistributeNests.hs
@@ -795,7 +795,9 @@
 
   dest_arrs_ts <- mapM (lookupType . kernelInputArray) dest_arrs
 
-  let k_body = KernelBody () k_body_stms (zipWith (inPlaceReturn ispace) dest_arrs_ts grouped)
+  let k_body =
+        KernelBody () k_body_stms $
+          zipWith (inPlaceReturn ispace) dest_arrs_ts grouped
       -- Remove unused kernel inputs, since some of these might
       -- reference the array we are scattering into.
       kernel_inps' =
@@ -814,15 +816,17 @@
     bad = error "Ill-typed nested scatter encountered."
 
     inPlaceReturn ispace arr_t (_, inp, is_vs) =
-      WriteReturns
-        ( foldMap (foldMap resCerts . fst) is_vs
-            <> foldMap (resCerts . snd) is_vs
-        )
-        (kernelInputArray inp)
-        [ (fullSlice arr_t $ map DimFix $ map Var (init gtids) ++ map resSubExp is, resSubExp v)
-          | (is, v) <- is_vs
-        ]
+      WriteReturns write_cs (kernelInputArray inp) $ do
+        (is, v) <- is_vs
+        pure
+          ( fullSlice arr_t . map DimFix $
+              map Var (init gtids) ++ map resSubExp is,
+            resSubExp v
+          )
       where
+        write_cs =
+          foldMap (foldMap resCerts . fst) is_vs
+            <> foldMap (resCerts . snd) is_vs
         (gtids, _ws) = unzip ispace
 
 segmentedUpdateKernel ::
diff --git a/src/Futhark/Pass/ExtractKernels/Intrablock.hs b/src/Futhark/Pass/ExtractKernels/Intrablock.hs
--- a/src/Futhark/Pass/ExtractKernels/Intrablock.hs
+++ b/src/Futhark/Pass/ExtractKernels/Intrablock.hs
@@ -300,13 +300,22 @@
       space <- mkSegSpace [(write_i, w)]
 
       let lam' = soacsLambdaToGPU lam
-          krets = do
-            (_a_w, a, is_vs) <-
-              groupScatterResults dests $ bodyResult $ lambdaBody lam'
+          grouped = groupScatterResults dests $ bodyResult $ lambdaBody lam'
+          (_, dest_arrs, _) = unzip3 grouped
+
+      dest_ts <- mapM lookupType dest_arrs
+
+      let krets = do
+            (a_t, (_a_w, a, is_vs)) <- zip dest_ts grouped
             let cs =
                   foldMap (foldMap resCerts . fst) is_vs
                     <> foldMap (resCerts . snd) is_vs
-                is_vs' = [(Slice $ map (DimFix . resSubExp) is, resSubExp v) | (is, v) <- is_vs]
+                is_vs' = do
+                  (is, v) <- is_vs
+                  pure
+                    ( fullSlice a_t $ map (DimFix . resSubExp) is,
+                      resSubExp v
+                    )
             pure $ WriteReturns cs a is_vs'
           inputs = do
             (p, p_a) <- zip (lambdaParams lam') ivs
diff --git a/src/Futhark/Pass/ExtractMulticore.hs b/src/Futhark/Pass/ExtractMulticore.hs
--- a/src/Futhark/Pass/ExtractMulticore.hs
+++ b/src/Futhark/Pass/ExtractMulticore.hs
@@ -188,7 +188,7 @@
   (reds_stms, reds') <- mapAndUnzipM reduceToSegBinOp reds
   op' <-
     renameIfNeeded rename $
-      SegRed () space reds' (lambdaReturnType map_lam) kbody
+      SegRed () space (lambdaReturnType map_lam) kbody reds'
   pure (reds_stms, op')
 
 transformHist ::
@@ -205,7 +205,7 @@
   (hists_stms, hists') <- mapAndUnzipM histToSegBinOp hists
   op' <-
     renameIfNeeded rename $
-      SegHist () space hists' (lambdaReturnType map_lam) kbody
+      SegHist () space (lambdaReturnType map_lam) kbody hists'
   pure (hists_stms, op')
 
 transformSOAC :: Pat Type -> Attrs -> SOAC SOACS -> ExtractM (Stms MC)
@@ -245,7 +245,7 @@
             ( Let pat (defAux ()) $
                 Op $
                   ParOp Nothing $
-                    SegScan () space scans' (lambdaReturnType map_lam) kbody
+                    SegScan () space (lambdaReturnType map_lam) kbody scans'
             )
   | otherwise = do
       -- This screma is too complicated for us to immediately do
diff --git a/src/Futhark/Pass/LiftAllocations.hs b/src/Futhark/Pass/LiftAllocations.hs
--- a/src/Futhark/Pass/LiftAllocations.hs
+++ b/src/Futhark/Pass/LiftAllocations.hs
@@ -120,15 +120,15 @@
 liftAllocationsInSegOp (SegMap lvl sp tps body) = do
   stms <- liftAllocationsInStms (kernelBodyStms body) mempty mempty mempty
   pure $ SegMap lvl sp tps $ body {kernelBodyStms = stms}
-liftAllocationsInSegOp (SegRed lvl sp binops tps body) = do
+liftAllocationsInSegOp (SegRed lvl sp tps body binops) = do
   stms <- liftAllocationsInStms (kernelBodyStms body) mempty mempty mempty
-  pure $ SegRed lvl sp binops tps $ body {kernelBodyStms = stms}
-liftAllocationsInSegOp (SegScan lvl sp binops tps body) = do
+  pure $ SegRed lvl sp tps (body {kernelBodyStms = stms}) binops
+liftAllocationsInSegOp (SegScan lvl sp tps body binops) = do
   stms <- liftAllocationsInStms (kernelBodyStms body) mempty mempty mempty
-  pure $ SegScan lvl sp binops tps $ body {kernelBodyStms = stms}
-liftAllocationsInSegOp (SegHist lvl sp histops tps body) = do
+  pure $ SegScan lvl sp tps (body {kernelBodyStms = stms}) binops
+liftAllocationsInSegOp (SegHist lvl sp tps body histops) = do
   stms <- liftAllocationsInStms (kernelBodyStms body) mempty mempty mempty
-  pure $ SegHist lvl sp histops tps $ body {kernelBodyStms = stms}
+  pure $ SegHist lvl sp tps (body {kernelBodyStms = stms}) histops
 
 liftAllocationsInHostOp ::
   HostOp NoOp (Aliases GPUMem) ->
diff --git a/src/Futhark/Pass/LowerAllocations.hs b/src/Futhark/Pass/LowerAllocations.hs
--- a/src/Futhark/Pass/LowerAllocations.hs
+++ b/src/Futhark/Pass/LowerAllocations.hs
@@ -111,15 +111,15 @@
 lowerAllocationsInSegOp (SegMap lvl sp tps body) = do
   stms <- lowerAllocationsInStms (kernelBodyStms body) mempty mempty
   pure $ SegMap lvl sp tps $ body {kernelBodyStms = stms}
-lowerAllocationsInSegOp (SegRed lvl sp binops tps body) = do
+lowerAllocationsInSegOp (SegRed lvl sp tps body binops) = do
   stms <- lowerAllocationsInStms (kernelBodyStms body) mempty mempty
-  pure $ SegRed lvl sp binops tps $ body {kernelBodyStms = stms}
-lowerAllocationsInSegOp (SegScan lvl sp binops tps body) = do
+  pure $ SegRed lvl sp tps (body {kernelBodyStms = stms}) binops
+lowerAllocationsInSegOp (SegScan lvl sp tps body binops) = do
   stms <- lowerAllocationsInStms (kernelBodyStms body) mempty mempty
-  pure $ SegScan lvl sp binops tps $ body {kernelBodyStms = stms}
-lowerAllocationsInSegOp (SegHist lvl sp histops tps body) = do
+  pure $ SegScan lvl sp tps (body {kernelBodyStms = stms}) binops
+lowerAllocationsInSegOp (SegHist lvl sp tps body histops) = do
   stms <- lowerAllocationsInStms (kernelBodyStms body) mempty mempty
-  pure $ SegHist lvl sp histops tps $ body {kernelBodyStms = stms}
+  pure $ SegHist lvl sp tps (body {kernelBodyStms = stms}) histops
 
 lowerAllocationsInHostOp :: HostOp NoOp GPUMem -> LowerM (HostOp NoOp GPUMem) (HostOp NoOp GPUMem)
 lowerAllocationsInHostOp (SegOp op) = SegOp <$> lowerAllocationsInSegOp op
diff --git a/src/Language/Futhark/Interpreter.hs b/src/Language/Futhark/Interpreter.hs
--- a/src/Language/Futhark/Interpreter.hs
+++ b/src/Language/Futhark/Interpreter.hs
@@ -51,7 +51,7 @@
 import Data.Set qualified as S
 import Data.Text qualified as T
 import Futhark.Data qualified as V
-import Futhark.Util (chunk, maybeHead)
+import Futhark.Util (chunk)
 import Futhark.Util.Loc
 import Futhark.Util.Pretty hiding (apply)
 import Language.Futhark hiding (Shape, matchDims)
@@ -62,6 +62,7 @@
 import Language.Futhark.Primitive (floatValue, intValue)
 import Language.Futhark.Primitive qualified as P
 import Language.Futhark.Semantic qualified as T
+import Language.Futhark.TypeChecker.Types (Subst (..), applySubst)
 import Prelude hiding (break, mod)
 
 data StackFrame = StackFrame
@@ -331,7 +332,7 @@
 lookupVar :: QualName VName -> Env -> Maybe TermBinding
 lookupVar = lookupInEnv envTerm
 
-lookupType :: QualName VName -> Env -> Maybe (Env, T.TypeBinding)
+lookupType :: QualName VName -> Env -> Maybe TypeBinding
 lookupType = lookupInEnv envType
 
 -- | A TermValue with a 'Nothing' type annotation is an intrinsic or
@@ -349,6 +350,9 @@
   show (TermPoly bv _) = unwords ["TermPoly", show bv]
   show (TermModule m) = unwords ["TermModule", show m]
 
+data TypeBinding = TypeBinding Env [TypeParam] StructRetType
+  deriving (Show)
+
 data Module
   = Module Env
   | ModuleFun (Module -> EvalM Module)
@@ -360,7 +364,7 @@
 -- | The actual type- and value environment.
 data Env = Env
   { envTerm :: M.Map VName TermBinding,
-    envType :: M.Map VName (Env, T.TypeBinding)
+    envType :: M.Map VName TypeBinding
   }
   deriving (Show)
 
@@ -400,7 +404,7 @@
       envType = M.map tbind m
     }
   where
-    tbind = (mempty,) . T.TypeAbbr Unlifted [] . RetType []
+    tbind = TypeBinding mempty [] . RetType []
 
 i64Env :: M.Map VName Int64 -> Env
 i64Env = valEnv . M.map f
@@ -647,17 +651,17 @@
    in second (const u) (arrayOf shape' $ toStruct et')
 expandType env (Scalar (TypeVar u tn args)) =
   case lookupType tn env of
-    Just (tn_env, T.TypeAbbr _ ps (RetType ext t')) ->
+    Just (TypeBinding tn_env ps (RetType ext t')) ->
       let (substs, types) = mconcat $ zipWith matchPtoA ps args
-          onDim (SizeClosure _ (Var v _ _))
-            | Just e <- M.lookup (qualLeaf v) substs =
-                SizeClosure env e
-          -- The next case can occur when a type with existential size
-          -- has been hidden by a module ascription,
-          -- e.g. tests/modules/sizeparams4.fut.
-          onDim (SizeClosure _ e)
-            | any (`elem` ext) $ fvVars $ freeInExp e = SizeClosure mempty anySize
-          onDim d = d
+          onDim (SizeClosure dim_env dim)
+            | any (`elem` ext) $ fvVars $ freeInExp dim =
+                -- The case can occur when a type with existential
+                -- size has been hidden by a module ascription, e.g.
+                -- tests/modules/sizeparams4.fut.
+                SizeClosure mempty anySize
+            | otherwise =
+                SizeClosure (env <> dim_env) $
+                  applySubst (`M.lookup` substs) dim
        in bimap onDim (const u) $ expandType (Env mempty types <> tn_env) t'
     Nothing ->
       -- This case only happens for built-in abstract types,
@@ -665,10 +669,10 @@
       Scalar (TypeVar u tn $ map expandArg args)
   where
     matchPtoA (TypeParamDim p _) (TypeArgDim e) =
-      (M.singleton p e, mempty)
-    matchPtoA (TypeParamType l p _) (TypeArgType t') =
+      (M.singleton p $ ExpSubst e, mempty)
+    matchPtoA (TypeParamType _ p _) (TypeArgType t') =
       let t'' = evalToStruct $ expandType env t' -- FIXME, we are throwing away the closure here.
-       in (mempty, M.singleton p (mempty, T.TypeAbbr l [] $ RetType [] t''))
+       in (mempty, M.singleton p (TypeBinding mempty [] $ RetType [] t''))
     matchPtoA _ _ = mempty
     expandArg (TypeArgDim s) = TypeArgDim $ SizeClosure env s
     expandArg (TypeArgType t) = TypeArgType $ expandType env t
@@ -999,7 +1003,7 @@
 eval env (Ascript e _ _) = eval env e
 eval env (Coerce e te (Info t) loc) = do
   v <- eval env e
-  t' <- evalTypeFully $ expandType env $ toStruct t
+  t' <- evalTypeFully $ expandType env t
   case checkShape (typeShape t') (valueShape v) of
     Just _ -> pure v
     Nothing ->
@@ -1121,13 +1125,12 @@
   where
     rev_substs = reverseSubstitutions substs
     replace v = fromMaybe [v] $ M.lookup v rev_substs
-    replaceQ v = maybe v qualName $ maybeHead =<< M.lookup (qualLeaf v) rev_substs
     replaceM f m = M.fromList $ do
       (k, v) <- M.toList m
       k' <- replace k
       pure (k', f v)
     onEnv (Env terms types) =
-      Env (replaceM onTerm terms) (replaceM (bimap onEnv onType) types)
+      Env (replaceM onTerm terms) (replaceM onType types)
     onModule (Module env) =
       Module $ onEnv env
     onModule (ModuleFun f) =
@@ -1135,10 +1138,7 @@
     onTerm (TermValue t v) = TermValue t v
     onTerm (TermPoly t v) = TermPoly t v
     onTerm (TermModule m) = TermModule $ onModule m
-    onType (T.TypeAbbr l ps t) = T.TypeAbbr l ps $ first onDim t
-    onDim (Var v typ loc) = Var (replaceQ v) typ loc
-    onDim (IntLit x t loc) = IntLit x t loc
-    onDim _ = error "Arbitrary expression not supported yet"
+    onType (TypeBinding env ps t) = TypeBinding (onEnv env) ps t
 
 evalModuleVar :: Env -> QualName VName -> EvalM Module
 evalModuleVar env qv =
@@ -1216,8 +1216,8 @@
   evalDec env $ LocalDec (OpenDec (ModImport name name' loc) loc) loc
 evalDec env (LocalDec d _) = evalDec env d
 evalDec env ModTypeDec {} = pure env
-evalDec env (TypeDec (TypeBind v l ps _ (Info (RetType dims t)) _ _)) = do
-  let abbr = (env, T.TypeAbbr l ps . RetType dims $ evalToStruct $ expandType env t)
+evalDec env (TypeDec (TypeBind v _ ps _ (Info (RetType dims t)) _ _)) = do
+  let abbr = TypeBinding env ps $ RetType dims t
   pure env {envType = M.insert v abbr $ envType env}
 evalDec env (ModDec (ModBind v ps ret body _ loc)) = do
   (mod_env, mod) <- evalModExp env $ wrapInLambda ps
@@ -2095,10 +2095,10 @@
     def s | nameFromText s `M.member` namesToPrimTypes = Nothing
     def s = error $ "Missing intrinsic: " ++ T.unpack s
 
-    tdef :: Name -> Maybe (Env, T.TypeBinding)
+    tdef :: Name -> Maybe TypeBinding
     tdef s = do
       t <- s `M.lookup` namesToPrimTypes
-      pure (mempty, T.TypeAbbr Unlifted [] $ RetType [] $ Scalar $ Prim t)
+      pure $ TypeBinding mempty [] $ RetType [] $ Scalar $ Prim t
 
 intrinsicVal :: Name -> Value
 intrinsicVal name =