diff --git a/futhark.cabal b/futhark.cabal
--- a/futhark.cabal
+++ b/futhark.cabal
@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 27326a3d0b5daec736d8b0de8fda5938beaf2ee6e75215a5cfb6a29b1008afb0
+-- hash: a75ffbf819d567c2108977d336c20ff7f11963b071dc0d9e581faa2f792dba99
 
 name:           futhark
-version:        0.7.4
+version:        0.8.1
 synopsis:       An optimising compiler for a functional, array-oriented language.
 description:    See the website at https://futhark-lang.org
 category:       Language
@@ -49,59 +49,6 @@
   location: https://github.com/diku-dk/futhark
 
 library
-  hs-source-dirs:
-      src
-  ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists
-  build-depends:
-      ansi-terminal >=0.6.3.1
-    , array >=0.4
-    , base >=4 && <5
-    , bifunctors >=5.4.2
-    , binary >=0.8.3
-    , blaze-html >=0.9.0.1
-    , bytestring >=0.10.8
-    , containers >=0.5
-    , data-binary-ieee754 >=0.1
-    , directory >=1.3.0.0
-    , directory-tree >=0.12.1
-    , dlist >=0.6.0.1
-    , extra >=1.5.3
-    , file-embed >=0.0.9
-    , filepath >=1.4.1.1
-    , free >=4.12.4
-    , gitrev >=1.2.0
-    , http-client >=0.5.7.0
-    , http-client-tls >=0.3.5.1
-    , http-conduit >=2.2.4
-    , language-c-quote >=0.12
-    , mainland-pretty >=0.6.1
-    , markdown >=0.1.16
-    , megaparsec >=7.0.1
-    , mtl >=2.2.1
-    , neat-interpolation >=0.3
-    , parallel >=3.2.1.0
-    , parser-combinators >=1.0.0
-    , process >=1.4.3.0
-    , process-extras >=0.7.2
-    , raw-strings-qq >=1.1
-    , regex-tdfa >=1.2
-    , srcloc >=0.4
-    , template-haskell >=2.11.1
-    , text >=1.2.2.2
-    , th-lift-instances >=0.1.11
-    , time >=1.6.0.1
-    , transformers >=0.3
-    , vector >=0.12
-    , vector-binary-instances >=0.2.2.0
-    , versions >=3.3.1
-    , zip-archive >=0.3.1.1
-    , zlib >=0.6.1.2
-  build-tools:
-      alex
-    , happy
-  if !impl(ghc >= 8.0)
-    build-depends:
-        semigroups ==0.18.*
   exposed-modules:
       Futhark.Actions
       Futhark.Analysis.AlgSimplify
@@ -149,6 +96,7 @@
       Futhark.CodeGen.ImpGen
       Futhark.CodeGen.ImpGen.Kernels
       Futhark.CodeGen.ImpGen.Kernels.ToOpenCL
+      Futhark.CodeGen.ImpGen.Kernels.Transpose
       Futhark.CodeGen.ImpGen.OpenCL
       Futhark.CodeGen.ImpGen.Sequential
       Futhark.CodeGen.OpenCL.Kernels
@@ -216,6 +164,7 @@
       Futhark.Optimise.Simplify.Rule
       Futhark.Optimise.Simplify.Rules
       Futhark.Optimise.TileLoops
+      Futhark.Optimise.TileLoops.RegTiling3D
       Futhark.Optimise.Unstream
       Futhark.Pass
       Futhark.Pass.ExpandAllocations
@@ -305,6 +254,59 @@
       Language.Futhark.Parser.Parser
       Language.Futhark.Parser.Lexer
       Paths_futhark
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists
+  build-depends:
+      ansi-terminal >=0.6.3.1
+    , array >=0.4
+    , base >=4 && <5
+    , bifunctors >=5.4.2
+    , binary >=0.8.3
+    , blaze-html >=0.9.0.1
+    , bytestring >=0.10.8
+    , containers >=0.5
+    , data-binary-ieee754 >=0.1
+    , directory >=1.3.0.0
+    , directory-tree >=0.12.1
+    , dlist >=0.6.0.1
+    , extra >=1.5.3
+    , file-embed >=0.0.9
+    , filepath >=1.4.1.1
+    , free >=4.12.4
+    , gitrev >=1.2.0
+    , http-client >=0.5.7.0
+    , http-client-tls >=0.3.5.1
+    , http-conduit >=2.2.4
+    , language-c-quote >=0.12
+    , mainland-pretty >=0.6.1
+    , markdown >=0.1.16
+    , megaparsec >=7.0.1
+    , mtl >=2.2.1
+    , neat-interpolation >=0.3
+    , parallel >=3.2.1.0
+    , parser-combinators >=1.0.0
+    , process >=1.4.3.0
+    , process-extras >=0.7.2
+    , raw-strings-qq >=1.1
+    , regex-tdfa >=1.2
+    , srcloc >=0.4
+    , template-haskell >=2.11.1
+    , text >=1.2.2.2
+    , th-lift-instances >=0.1.11
+    , time >=1.6.0.1
+    , transformers >=0.3
+    , vector >=0.12
+    , vector-binary-instances >=0.2.2.0
+    , versions >=3.3.1
+    , zip-archive >=0.3.1.1
+    , zlib >=0.6.1.2
+  build-tools:
+      alex
+    , happy
+  if !impl(ghc >= 8.0)
+    build-depends:
+        semigroups ==0.18.*
   default-language: Haskell2010
 
 executable futhark
@@ -1062,6 +1064,19 @@
 test-suite unit
   type: exitcode-stdio-1.0
   main-is: futhark_tests.hs
+  other-modules:
+      Futhark.Analysis.ScalExpTests
+      Futhark.Optimise.AlgSimplifyTests
+      Futhark.Pkg.SolveTests
+      Futhark.Representation.AST.Attributes.RearrangeTests
+      Futhark.Representation.AST.Attributes.ReshapeTests
+      Futhark.Representation.AST.AttributesTests
+      Futhark.Representation.AST.Syntax.CoreTests
+      Futhark.Representation.AST.SyntaxTests
+      Futhark.Representation.PrimitiveTests
+      Language.Futhark.CoreTests
+      Language.Futhark.SyntaxTests
+      Paths_futhark
   hs-source-dirs:
       unittests
   ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists
@@ -1118,17 +1133,4 @@
   if !impl(ghc >= 8.0)
     build-depends:
         semigroups ==0.18.*
-  other-modules:
-      Futhark.Analysis.ScalExpTests
-      Futhark.Optimise.AlgSimplifyTests
-      Futhark.Pkg.SolveTests
-      Futhark.Representation.AST.Attributes.RearrangeTests
-      Futhark.Representation.AST.Attributes.ReshapeTests
-      Futhark.Representation.AST.AttributesTests
-      Futhark.Representation.AST.Syntax.CoreTests
-      Futhark.Representation.AST.SyntaxTests
-      Futhark.Representation.PrimitiveTests
-      Language.Futhark.CoreTests
-      Language.Futhark.SyntaxTests
-      Paths_futhark
   default-language: Haskell2010
diff --git a/rts/c/opencl.h b/rts/c/opencl.h
--- a/rts/c/opencl.h
+++ b/rts/c/opencl.h
@@ -2,6 +2,8 @@
 
 #define CL_USE_DEPRECATED_OPENCL_1_2_APIS
 
+#define CL_SILENCE_DEPRECATION // For macOS.
+
 #ifdef __APPLE__
   #include <OpenCL/cl.h>
 #else
@@ -43,7 +45,6 @@
   size_t default_num_groups;
   size_t default_tile_size;
   size_t default_threshold;
-  size_t transpose_block_dim;
 
   int default_group_size_changed;
   int default_tile_size_changed;
@@ -73,7 +74,6 @@
   cfg->default_num_groups = 128;
   cfg->default_tile_size = 32;
   cfg->default_threshold = 32*1024;
-  cfg->transpose_block_dim = 16;
 
   cfg->default_group_size_changed = 0;
   cfg->default_tile_size_changed = 0;
@@ -629,6 +629,10 @@
   // Make sure this function is defined.
   post_opencl_setup(ctx, &device_option);
 
+  if (ctx->lockstep_width == 0) {
+    ctx->lockstep_width = 1;
+  }
+
   if (ctx->cfg.logging) {
     fprintf(stderr, "Lockstep width: %d\n", (int)ctx->lockstep_width);
     fprintf(stderr, "Default group size: %d\n", (int)ctx->cfg.default_group_size);
@@ -686,8 +690,7 @@
   char *compile_opts = malloc(compile_opts_size);
 
   int w = snprintf(compile_opts, compile_opts_size,
-                   "-DFUT_BLOCK_DIM=%d -DLOCKSTEP_WIDTH=%d ",
-                   (int)ctx->cfg.transpose_block_dim,
+                   "-DLOCKSTEP_WIDTH=%d ",
                    (int)ctx->lockstep_width);
 
   for (int i = 0; i < ctx->cfg.num_sizes; i++) {
@@ -707,7 +710,7 @@
                                const char *srcs[],
                                int required_types) {
 
-  ctx->lockstep_width = 1;
+  ctx->lockstep_width = 0; // Real value set later.
 
   free_list_init(&ctx->free_list);
 
diff --git a/rts/csharp/opencl.cs b/rts/csharp/opencl.cs
--- a/rts/csharp/opencl.cs
+++ b/rts/csharp/opencl.cs
@@ -35,7 +35,6 @@
     public int DefaultNumGroups;
     public int DefaultTileSize;
     public int DefaultThreshold;
-    public int TransposeBlockDim;
 
     public int NumSizes;
     public string[] SizeNames;
@@ -377,7 +376,6 @@
     cfg.DefaultNumGroups = 128;
     cfg.DefaultTileSize = 32;
     cfg.DefaultThreshold = 32*1024;
-    cfg.TransposeBlockDim = 16;
 
     cfg.NumSizes = num_sizes;
     cfg.SizeNames = size_names;
@@ -870,8 +868,7 @@
 
     int compile_opts_size = 1024;
 
-    string compile_opts = String.Format("-DFUT_BLOCK_DIM={0} -DLOCKSTEP_WIDTH={1} ",
-                                        ctx.OpenCL.Cfg.TransposeBlockDim,
+    string compile_opts = String.Format("-DLOCKSTEP_WIDTH={0} ",
                                         ctx.OpenCL.LockstepWidth);
 
     for (int i = 0; i < ctx.OpenCL.Cfg.NumSizes; i++) {
diff --git a/rts/python/opencl.py b/rts/python/opencl.py
--- a/rts/python/opencl.py
+++ b/rts/python/opencl.py
@@ -81,7 +81,6 @@
                              default_num_groups=None,
                              default_tile_size=None,
                              default_threshold=None,
-                             transpose_block_dim=16,
                              size_heuristics=[],
                              required_types=[],
                              all_sizes={},
@@ -167,8 +166,7 @@
 
     if (len(program_src) >= 0):
         return cl.Program(self.ctx, program_src).build(
-            ["-DFUT_BLOCK_DIM={}".format(transpose_block_dim),
-             "-DLOCKSTEP_WIDTH={}".format(lockstep_width)]
+            ["-DLOCKSTEP_WIDTH={}".format(lockstep_width)]
             + ["-D{}={}".format(s,v) for (s,v) in self.sizes.items()])
 
 def opencl_alloc(self, min_size, tag):
diff --git a/rts/python/values.py b/rts/python/values.py
--- a/rts/python/values.py
+++ b/rts/python/values.py
@@ -24,9 +24,12 @@
         self.lookahead_buffer = [c] + self.lookahead_buffer
 
     def get_chars(self, n):
-        s = b''
-        for _ in range(n):
-            s += self.get_char()
+        n1 = min(n, len(self.lookahead_buffer))
+        s = b''.join(self.lookahead_buffer[:n1])
+        self.lookahead_buffer = self.lookahead_buffer[n1:]
+        n2 = n - n1
+        if n2 > 0:
+            s += self.f.read(n2)
         return s
 
     def peek_char(self):
diff --git a/src/Futhark/Analysis/Metrics.hs b/src/Futhark/Analysis/Metrics.hs
--- a/src/Futhark/Analysis/Metrics.hs
+++ b/src/Futhark/Analysis/Metrics.hs
@@ -123,7 +123,6 @@
 primOpMetrics Reshape{} = seen "Reshape"
 primOpMetrics Rearrange{} = seen "Rearrange"
 primOpMetrics Rotate{} = seen "Rotate"
-primOpMetrics Partition{} = seen "Partition"
 
 lambdaMetrics :: OpMetrics (Op lore) => Lambda lore -> MetricsM ()
 lambdaMetrics = bodyMetrics . lambdaBody
diff --git a/src/Futhark/Analysis/PrimExp.hs b/src/Futhark/Analysis/PrimExp.hs
--- a/src/Futhark/Analysis/PrimExp.hs
+++ b/src/Futhark/Analysis/PrimExp.hs
@@ -6,8 +6,11 @@
   , evalPrimExp
   , primExpType
   , coerceIntPrimExp
+  , true
+  , false
 
   , module Futhark.Representation.Primitive
+  , (.&&.), (.||.), (.<.), (.<=.), (.>.), (.>=.), (.==.), (.&.), (.|.), (.^.)
   ) where
 
 import           Data.Foldable
@@ -150,6 +153,39 @@
   fromInt32 = ValueExp . IntValue . Int32Value
   fromInt64 = ValueExp . IntValue . Int64Value
 
+-- | Lifted logical conjunction.
+(.&&.) :: PrimExp v -> PrimExp v -> PrimExp v
+x .&&. y = BinOpExp LogAnd x y
+
+-- | Lifted logical conjunction.
+(.||.) :: PrimExp v -> PrimExp v -> PrimExp v
+x .||. y = BinOpExp LogOr x y
+
+-- | Lifted relational operators; assuming signed numbers in case of
+-- integers.
+(.<.), (.>.), (.<=.), (.>=.), (.==.) :: PrimExp v -> PrimExp v -> PrimExp v
+x .<. y = CmpOpExp cmp x y where cmp = case primExpType x of
+                                         IntType t -> CmpSlt $ t `min` primExpIntType y
+                                         FloatType t -> FCmpLt t
+                                         _ -> CmpLlt
+x .<=. y = CmpOpExp cmp x y where cmp = case primExpType x of
+                                          IntType t -> CmpSle $ t `min` primExpIntType y
+                                          FloatType t -> FCmpLe t
+                                          _ -> CmpLle
+x .==. y = CmpOpExp (CmpEq $ primExpType x `min` primExpType y) x y
+x .>. y = y .<. x
+x .>=. y = y .<=. x
+
+-- | Lifted bitwise operators.
+(.&.), (.|.), (.^.) :: PrimExp v -> PrimExp v -> PrimExp v
+x .&. y = BinOpExp (And $ primExpIntType x `min` primExpIntType y) x y
+x .|. y = BinOpExp (Or $ primExpIntType x `min` primExpIntType y) x y
+x .^. y = BinOpExp (Xor $ primExpIntType x `min` primExpIntType y) x y
+
+infix 4 .==., .<., .>., .<=., .>=.
+infixr 3 .&&.
+infixr 2 .||.
+
 asIntOp :: (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
 asIntOp f x y
   | IntType t <- primExpType x,
@@ -255,6 +291,15 @@
 coerceIntPrimExp :: IntType -> PrimExp v -> PrimExp v
 coerceIntPrimExp t (ValueExp (IntValue v)) = ValueExp $ IntValue $ doSExt v t
 coerceIntPrimExp _ e                       = e
+
+primExpIntType :: PrimExp v -> IntType
+primExpIntType e = case primExpType e of IntType t -> t
+                                         _         -> Int64
+
+-- | Boolean-valued PrimExps.
+true, false :: PrimExp v
+true = ValueExp $ BoolValue True
+false = ValueExp $ BoolValue False
 
 -- Prettyprinting instances
 
diff --git a/src/Futhark/Analysis/SymbolTable.hs b/src/Futhark/Analysis/SymbolTable.hs
--- a/src/Futhark/Analysis/SymbolTable.hs
+++ b/src/Futhark/Analysis/SymbolTable.hs
@@ -31,6 +31,8 @@
   , lookupValue
   , lookupVar
   , lookupAliases
+  , available
+  , consume
   , index
   , index'
   , IndexOp(..)
@@ -131,6 +133,7 @@
               , freeVarStmDepth = letBoundStmDepth e
               , freeVarRange = letBoundRange e
               , freeVarIndex = \name is -> index' name is table
+              , freeVarConsumed = letBoundConsumed e
               }
 
         fParam e = FParam e { fparamAttr = fparamAttr e }
@@ -181,6 +184,8 @@
                 , letBoundScalExp  :: Maybe ScalExp
                 , letBoundIndex    :: Int -> IndexArray
                 -- ^ Index a delayed array, if possible.
+                , letBoundConsumed :: Bool
+                  -- ^ True if consumed.
                 }
 
 data FParamEntry lore =
@@ -188,6 +193,7 @@
               , fparamAttr     :: FParamAttr lore
               , fparamAliases  :: Names
               , fparamStmDepth :: Int
+              , fparamConsumed :: Bool
               }
 
 data LParamEntry lore =
@@ -195,6 +201,7 @@
               , lparamAttr     :: LParamAttr lore
               , lparamStmDepth :: Int
               , lparamIndex    :: IndexArray
+              , lparamConsumed :: Bool
               }
 
 data FreeVarEntry lore =
@@ -203,6 +210,8 @@
                , freeVarRange    :: ScalExpRange
                , freeVarIndex    :: VName -> IndexArray
                 -- ^ Index a delayed array, if possible.
+               , freeVarConsumed :: Bool
+                -- ^ True if consumed.
                }
 
 entryInfo :: Entry lore -> NameInfo lore
@@ -260,6 +269,13 @@
 setValueRange range (FreeVar entry) =
   FreeVar $ entry { freeVarRange = range }
 
+consumed :: Entry lore -> Bool
+consumed (LetBound entry) = letBoundConsumed entry
+consumed (FParam entry)   = fparamConsumed entry
+consumed (LParam entry)   = lparamConsumed entry
+consumed LoopVar{}        = False
+consumed (FreeVar entry)  = freeVarConsumed entry
+
 entryStm :: Entry lore -> Maybe (Stm lore)
 entryStm (LetBound entry) = Just $ letBoundStm entry
 entryStm _                = Nothing
@@ -339,6 +355,10 @@
                               Just (FParam e)   -> fparamAliases e
                               _                 -> mempty
 
+-- | In symbol table and not consumed.
+available :: VName -> SymbolTable lore -> Bool
+available name = maybe False (not . consumed) . M.lookup name . bindings
+
 index :: Attributes lore => VName -> [SubExp] -> SymbolTable lore
       -> Maybe (PrimExp VName, Certificates)
 index name is table = do
@@ -455,6 +475,7 @@
     , letBoundStmDepth = 0
     , letBoundIndex = \k -> fmap (second (<>(stmAuxCerts $ stmAux bnd))) .
                             indexExp vtable (stmExp bnd) k
+    , letBoundConsumed = False
     }
   where ranges :: AS.RangesRep
         ranges = rangesRep vtable
@@ -522,11 +543,12 @@
           -> SymbolTable lore
           -> SymbolTable lore
 insertStm stm vtable =
-  foldl' addRevAliases
-  (insertEntries (zip names $ map LetBound $ bindingEntries stm vtable) vtable) $
-  patternElements $ stmPattern stm
+  flip (foldl' $ flip consume) stm_consumed $
+  flip (foldl' addRevAliases) (patternElements $ stmPattern stm) $
+  insertEntries (zip names $ map LetBound $ bindingEntries stm vtable) vtable
   where names = patternNames $ stmPattern stm
         adjustSeveral f = flip $ foldl' $ flip $ M.adjust f
+        stm_consumed = expandAliases (Aliases.consumedInStm stm) vtable
         addRevAliases vtable' pe =
           vtable' { bindings = adjustSeveral update inedges $ bindings vtable' }
           where inedges = expandAliases (Aliases.aliasesOf pe) vtable'
@@ -553,6 +575,7 @@
                                    , fparamAttr = AST.paramAttr fparam
                                    , fparamAliases = mempty
                                    , fparamStmDepth = 0
+                                   , fparamConsumed = False
                                    }
 
 insertFParams :: Attributes lore =>
@@ -573,6 +596,7 @@
                                   , lparamAttr = AST.paramAttr param
                                   , lparamStmDepth = 0
                                   , lparamIndex = indexf
+                                  , lparamConsumed = False
                                   }
         name = AST.paramName param
         sizevars = subExpVars $ arrayDims $ AST.paramType param
@@ -626,6 +650,7 @@
           , freeVarRange = (Nothing, Nothing)
           , freeVarStmDepth = 0
           , freeVarIndex  = \_ _ -> Nothing
+          , freeVarConsumed = False
           }
 
 updateBounds :: Attributes lore => Bool -> SubExp -> SymbolTable lore -> SymbolTable lore
@@ -725,6 +750,16 @@
                                            (S.insert sym cur_syms)
                                            (S.toList $ S.fromList sym_bds)
                Nothing        -> S.insert sym cur_syms
+
+consume :: Attributes lore => VName -> SymbolTable lore -> SymbolTable lore
+consume consumee vtable = foldl' consume' vtable $ expandAliases (S.singleton consumee) vtable
+  where consume' vtable' v | Just e <- lookup v vtable = insertEntry v (consume'' e) vtable'
+                           | otherwise                 = vtable'
+        consume'' (FreeVar e)  = FreeVar e { freeVarConsumed = True }
+        consume'' (LetBound e) = LetBound e { letBoundConsumed = True }
+        consume'' (FParam e)   = FParam e { fparamConsumed = True }
+        consume'' (LParam e)   = LParam e { lparamConsumed = True }
+        consume'' (LoopVar e)  = LoopVar e
 
 setUpperBound :: VName -> ScalExp -> SymbolTable lore
               -> SymbolTable lore
diff --git a/src/Futhark/CodeGen/Backends/COpenCL.hs b/src/Futhark/CodeGen/Backends/COpenCL.hs
--- a/src/Futhark/CodeGen/Backends/COpenCL.hs
+++ b/src/Futhark/CodeGen/Backends/COpenCL.hs
@@ -124,12 +124,22 @@
                       }
              ]
 
+-- We detect the special case of writing a constant and turn it into a
+-- non-blocking write.  This may be slightly faster, as it prevents
+-- unnecessary synchronisation of the OpenCL command queue, and
+-- writing a constant is fairly common.  This is only possible because
+-- we can give the constant infinite lifetime (with 'static'), which
+-- is not the case for ordinary variables.
 writeOpenCLScalar :: GC.WriteScalar OpenCL ()
 writeOpenCLScalar mem i t "device" _ val = do
   val' <- newVName "write_tmp"
-  GC.stm [C.cstm|{$ty:t $id:val' = $exp:val;
+  let (decl, blocking) =
+        case val of
+          C.Const{} -> ([C.citem|static $ty:t $id:val' = $exp:val;|], [C.cexp|CL_FALSE|])
+          _         -> ([C.citem|$ty:t $id:val' = $exp:val;|], [C.cexp|CL_TRUE|])
+  GC.stm [C.cstm|{$item:decl
                   OPENCL_SUCCEED_OR_RETURN(
-                    clEnqueueWriteBuffer(ctx->opencl.queue, $exp:mem, CL_TRUE,
+                    clEnqueueWriteBuffer(ctx->opencl.queue, $exp:mem, $exp:blocking,
                                          $exp:i, sizeof($ty:t),
                                          &$id:val',
                                          0, NULL, NULL));
diff --git a/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs b/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs
--- a/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs
+++ b/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs
@@ -70,7 +70,6 @@
                             };|])
 
   let size_value_inits = map (\i -> [C.cstm|cfg->sizes[$int:i] = 0;|]) [0..M.size sizes-1]
-      transposeBlockDim' = transposeBlockDim :: Int
   GC.publicDef_ "context_config_new" GC.InitDecl $ \s ->
     ([C.cedecl|struct $id:cfg* $id:s(void);|],
      [C.cedecl|struct $id:cfg* $id:s(void) {
@@ -82,8 +81,6 @@
                          $stms:size_value_inits
                          opencl_config_init(&cfg->opencl, $int:num_sizes,
                                             size_names, cfg->sizes, size_classes, size_entry_points);
-
-                         cfg->opencl.transpose_block_dim = $int:transposeBlockDim';
                          return cfg;
                        }|])
 
diff --git a/src/Futhark/CodeGen/Backends/CSOpenCL/Boilerplate.hs b/src/Futhark/CodeGen/Backends/CSOpenCL/Boilerplate.hs
--- a/src/Futhark/CodeGen/Backends/CSOpenCL/Boilerplate.hs
+++ b/src/Futhark/CodeGen/Backends/CSOpenCL/Boilerplate.hs
@@ -79,7 +79,6 @@
     , Reassign (Field tmp_cfg "Sizes") (Collection "int[]" (replicate (M.size sizes) (Integer 0)))
     , Exp $ CS.simpleCall "OpenCLConfigInit" [ Out $ Field tmp_cfg "OpenCL", (Integer . toInteger) $ M.size sizes
                                                , Var "SizeNames", Field tmp_cfg "Sizes", Var "SizeClasses" ]
-    , Reassign (Field tmp_cfg "OpenCL.TransposeBlockDim") (Integer transposeBlockDim)
     , Return tmp_cfg
     ]
 
diff --git a/src/Futhark/CodeGen/Backends/GenericC.hs b/src/Futhark/CodeGen/Backends/GenericC.hs
--- a/src/Futhark/CodeGen/Backends/GenericC.hs
+++ b/src/Futhark/CodeGen/Backends/GenericC.hs
@@ -741,7 +741,7 @@
   ctx_ty <- contextType
 
   headerDecl (ArrayDecl name)
-    [C.cedecl|struct $id:name;|]
+    [C.cedecl|struct $id:arr_name;|]
   headerDecl (ArrayDecl name)
     [C.cedecl|$ty:array_type* $id:new_array($ty:ctx_ty *ctx, $ty:pt' *data, $params:shape_params);|]
   headerDecl (ArrayDecl name)
diff --git a/src/Futhark/CodeGen/ImpCode.hs b/src/Futhark/CodeGen/ImpCode.hs
--- a/src/Futhark/CodeGen/ImpCode.hs
+++ b/src/Futhark/CodeGen/ImpCode.hs
@@ -327,7 +327,7 @@
   ppr (SetMem dest from space) =
     ppr dest <+> text "<-" <+> ppr from <+> text "@" <> ppr space
   ppr (Assert e msg _) =
-    text "assert" <> parens (commasep [text (show msg), ppr e])
+    text "assert" <> parens (commasep [ppr msg, ppr e])
   ppr (Copy dest destoffset destspace src srcoffset srcspace size) =
     text "memcpy" <>
     parens (ppMemLoc dest destoffset <> ppr destspace <> comma </>
diff --git a/src/Futhark/CodeGen/ImpCode/Kernels.hs b/src/Futhark/CodeGen/ImpCode/Kernels.hs
--- a/src/Futhark/CodeGen/ImpCode/Kernels.hs
+++ b/src/Futhark/CodeGen/ImpCode/Kernels.hs
@@ -21,6 +21,7 @@
   , module Futhark.Representation.Kernels.Sizes
   -- * Utility functions
   , getKernels
+  , atomicBinOp
   )
   where
 
@@ -57,7 +58,6 @@
 
 data CallKernel = Map MapKernel
                 | AnyKernel Kernel
-                | MapTranspose PrimType VName Exp VName Exp Exp Exp Exp Exp Exp
             deriving (Show)
 
 -- | A generic kernel containing arbitrary kernel code.
@@ -83,12 +83,10 @@
               , kernelUses :: [KernelUse]
                 -- ^ The host variables referenced by the kernel.
 
-              , kernelNumGroups :: DimSize
-              , kernelGroupSize :: DimSize
-              , kernelName :: VName
-                -- ^ Unique name for the kernel.
-              , kernelDesc :: String
-               -- ^ A short descriptive name - should be
+              , kernelNumGroups :: [Imp.Exp]
+              , kernelGroupSize :: [Imp.Exp]
+              , kernelName :: Name
+               -- ^ A short descriptive and _unique_ name - should be
                -- alphanumeric and without spaces.
               }
             deriving (Show)
@@ -97,7 +95,7 @@
 type LocalMemoryUse = (VName, Either MemSize KernelConstExp)
 
 data KernelUse = ScalarUse VName PrimType
-               | MemoryUse VName Imp.DimSize
+               | MemoryUse VName
                | ConstUse VName KernelConstExp
                  deriving (Eq, Show)
 
@@ -107,18 +105,28 @@
           tell [kernel]
         getFunKernels _ =
           return ()
-        sameKernel (MapTranspose bt1 _ _ _ _ _ _ _ _ _) (MapTranspose bt2 _ _ _ _ _ _ _ _ _) =
-          bt1 == bt2
         sameKernel _ _ = False
 
+-- | Get an atomic operator corresponding to a binary operator.
+atomicBinOp :: BinOp -> Maybe (VName -> VName -> Count Bytes -> Exp -> AtomicOp)
+atomicBinOp = flip lookup [ (Add Int32, AtomicAdd)
+                          , (SMax Int32, AtomicSMax)
+                          , (SMin Int32, AtomicSMin)
+                          , (UMax Int32, AtomicUMax)
+                          , (UMin Int32, AtomicUMin)
+                          , (And Int32, AtomicAnd)
+                          , (Or Int32, AtomicOr)
+                          , (Xor Int32, AtomicXor)
+                          ]
+
 instance Pretty KernelConst where
   ppr (SizeConst key) = text "get_size" <> parens (ppr key)
 
 instance Pretty KernelUse where
   ppr (ScalarUse name t) =
     text "scalar_copy" <> parens (commasep [ppr name, ppr t])
-  ppr (MemoryUse name size) =
-    text "mem_copy" <> parens (commasep [ppr name, ppr size])
+  ppr (MemoryUse name) =
+    text "mem_copy" <> parens (commasep [ppr name])
   ppr (ConstUse name e) =
     text "const" <> parens (commasep [ppr name, ppr e])
 
@@ -147,25 +155,10 @@
 instance Pretty CallKernel where
   ppr (Map k) = ppr k
   ppr (AnyKernel k) = ppr k
-  ppr (MapTranspose bt dest destoffset src srcoffset num_arrays size_x size_y in_size out_size) =
-    text "mapTranspose" <>
-    parens (ppr bt <> comma </>
-            ppMemLoc dest destoffset <> comma </>
-            ppMemLoc src srcoffset <> comma </>
-            ppr num_arrays <> comma <+>
-            ppr size_x <> comma <+>
-            ppr size_y <> comma <+>
-            ppr in_size <> comma <+>
-            ppr out_size)
-    where ppMemLoc base offset =
-            ppr base <+> text "+" <+> ppr offset
 
 instance FreeIn CallKernel where
   freeIn (Map k) = freeIn k
   freeIn (AnyKernel k) = freeIn k
-  freeIn (MapTranspose _ dest destoffset src srcoffset num_arrays size_x size_y in_size out_size) =
-    freeIn [dest, src] <> freeIn [destoffset, srcoffset] <> freeIn num_arrays <>
-    freeIn [size_x, size_y] <> freeIn [in_size, out_size]
 
 instance FreeIn Kernel where
   freeIn kernel = freeIn (kernelBody kernel) <>
diff --git a/src/Futhark/CodeGen/ImpCode/OpenCL.hs b/src/Futhark/CodeGen/ImpCode/OpenCL.hs
--- a/src/Futhark/CodeGen/ImpCode/OpenCL.hs
+++ b/src/Futhark/CodeGen/ImpCode/OpenCL.hs
@@ -14,7 +14,6 @@
        , KernelName
        , KernelArg (..)
        , OpenCL (..)
-       , transposeBlockDim
        , module Futhark.CodeGen.ImpCode
        , module Futhark.Representation.Kernels.Sizes
        )
@@ -65,10 +64,6 @@
             | CmpSizeLe VName VName Exp
             | GetSizeMax VName SizeClass
             deriving (Show)
-
--- | The block size when transposing.
-transposeBlockDim :: Num a => a
-transposeBlockDim = 16
 
 instance Pretty OpenCL where
   ppr = text . show
diff --git a/src/Futhark/CodeGen/ImpGen.hs b/src/Futhark/CodeGen/ImpGen.hs
--- a/src/Futhark/CodeGen/ImpGen.hs
+++ b/src/Futhark/CodeGen/ImpGen.hs
@@ -9,21 +9,26 @@
   , OpCompiler
   , ExpCompiler
   , CopyCompiler
-  , BodyCompiler
+  , StmsCompiler
   , Operations (..)
   , defaultOperations
-  , Destination (..)
-  , ValueDestination (..)
+  , ValueDestination
+  , arrayDestination
   , MemLocation (..)
   , MemEntry (..)
   , ScalarEntry (..)
 
     -- * Monadic Compiler Interface
   , ImpM
-  , Env (envVtable, envDefaultSpace)
+  , Env (envDefaultSpace)
+  , VTable
+  , getVTable
+  , localVTable
   , subImpM
   , subImpM_
   , emit
+  , emitFunction
+  , hasFunction
   , collect
   , comment
   , VarEntry (..)
@@ -32,7 +37,6 @@
     -- * Lookups
   , lookupVar
   , lookupArray
-  , arrayLocation
   , lookupMemory
 
     -- * Building Blocks
@@ -42,22 +46,14 @@
   , compilePrimExp
   , compileAlloc
   , subExpToDimSize
-  , declaringLParams
-  , declaringFParams
-  , declaringVarEntry
-  , declaringScope
-  , declaringScopes
-  , declaringPrimVar
-  , declaringPrimVars
-  , withPrimVar
   , everythingVolatile
   , compileBody
+  , compileBody'
   , compileLoopBody
-  , defCompileBody
+  , defCompileStms
   , compileStms
   , compileExp
   , defCompileExp
-  , sliceArray
   , offsetArray
   , strideArray
   , fullyIndexArray
@@ -65,19 +61,32 @@
   , varIndex
   , Imp.dimSizeToExp
   , dimSizeToSubExp
-  , destinationFromParam
-  , destinationFromParams
-  , destinationFromPattern
-  , funcallTargets
   , copy
   , copyDWIM
   , copyDWIMDest
   , copyElementWise
+
+  -- * Constructing code.
+  , dLParams
+  , dFParams
+  , dScope
+  , dScopes
+  , dArray
+  , dPrim, dPrim_, dPrimV
+
+  , sFor, sWhile
+  , sComment
+  , sIf, sWhen, sUnless
+  , sOp
+  , sAlloc
+  , sArray
+  , sWrite
+  , (<--)
   )
   where
 
 import Control.Monad.RWS    hiding (mapM, forM)
-import Control.Monad.State  hiding (mapM, forM)
+import Control.Monad.State  hiding (mapM, forM, State)
 import Control.Monad.Writer hiding (mapM, forM)
 import Control.Monad.Except hiding (mapM, forM)
 import qualified Control.Monad.Fail as Fail
@@ -102,13 +111,13 @@
 import Futhark.Util
 
 -- | How to compile an 'Op'.
-type OpCompiler lore op = Destination -> Op lore -> ImpM lore op ()
+type OpCompiler lore op = Pattern lore -> Op lore -> ImpM lore op ()
 
--- | How to compile a 'Body'.
-type BodyCompiler lore op = Destination -> Body lore -> ImpM lore op ()
+-- | How to compile some 'Stms'.
+type StmsCompiler lore op = Names -> [Stm lore] -> ImpM lore op () -> ImpM lore op ()
 
 -- | How to compile an 'Exp'.
-type ExpCompiler lore op = Destination -> Exp lore -> ImpM lore op ()
+type ExpCompiler lore op = Pattern lore -> Exp lore -> ImpM lore op ()
 
 type CopyCompiler lore op = PrimType
                            -> MemLocation
@@ -118,7 +127,7 @@
 
 data Operations lore op = Operations { opsExpCompiler :: ExpCompiler lore op
                                      , opsOpCompiler :: OpCompiler lore op
-                                     , opsBodyCompiler :: BodyCompiler lore op
+                                     , opsStmsCompiler :: StmsCompiler lore op
                                      , opsCopyCompiler :: CopyCompiler lore op
                                      }
 
@@ -128,11 +137,11 @@
                      OpCompiler lore op -> Operations lore op
 defaultOperations opc = Operations { opsExpCompiler = defCompileExp
                                    , opsOpCompiler = opc
-                                   , opsBodyCompiler = defCompileBody
+                                   , opsStmsCompiler = defCompileStms
                                    , opsCopyCompiler = defaultCopy
                                    }
 
--- | When an array is declared, this is where it is stored.
+-- | When an array is dared, this is where it is stored.
 data MemLocation = MemLocation { memLocationName :: VName
                                , memLocationShape :: [Imp.DimSize]
                                , memLocationIxFun :: IxFun.IxFun Imp.Exp
@@ -171,7 +180,6 @@
                     deriving (Show)
 
 data ValueDestination = ScalarDestination VName
-                      | ArrayElemDestination VName PrimType Imp.Space (Count Bytes)
                       | MemoryDestination VName
                       | ArrayDestination (Maybe MemLocation)
                         -- ^ The 'MemLocation' is 'Just' if a copy if
@@ -180,16 +188,12 @@
                         -- takes care of this array.
                       deriving (Show)
 
--- | If the given value destination if a 'ScalarDestination', return
--- the variable name.  Otherwise, 'Nothing'.
-fromScalarDestination :: ValueDestination -> Maybe VName
-fromScalarDestination (ScalarDestination name) = Just name
-fromScalarDestination _                        = Nothing
+arrayDestination :: MemLocation -> ValueDestination
+arrayDestination = ArrayDestination . Just
 
 data Env lore op = Env {
-    envVtable :: M.Map VName (VarEntry lore)
-  , envExpCompiler :: ExpCompiler lore op
-  , envBodyCompiler :: BodyCompiler lore op
+    envExpCompiler :: ExpCompiler lore op
+  , envStmsCompiler :: StmsCompiler lore op
   , envOpCompiler :: OpCompiler lore op
   , envCopyCompiler :: CopyCompiler lore op
   , envDefaultSpace :: Imp.Space
@@ -197,18 +201,28 @@
   }
 
 newEnv :: Operations lore op -> Imp.Space -> Env lore op
-newEnv ops ds = Env { envVtable = M.empty
-                    , envExpCompiler = opsExpCompiler ops
-                    , envBodyCompiler = opsBodyCompiler ops
+newEnv ops ds = Env { envExpCompiler = opsExpCompiler ops
+                    , envStmsCompiler = opsStmsCompiler ops
                     , envOpCompiler = opsOpCompiler ops
                     , envCopyCompiler = opsCopyCompiler ops
                     , envDefaultSpace = ds
                     , envVolatility = Imp.Nonvolatile
                     }
 
-newtype ImpM lore op a = ImpM (RWST (Env lore op) (Imp.Code op) VNameSource (Either InternalError) a)
+-- | The symbol table used during compilation.
+type VTable lore = M.Map VName (VarEntry lore)
+
+data State lore op = State { stateVTable :: VTable lore
+                           , stateFunctions :: Imp.Functions op
+                           , stateNameSource :: VNameSource
+                           }
+
+newState :: VNameSource -> State lore op
+newState = State mempty mempty
+
+newtype ImpM lore op a = ImpM (RWST (Env lore op) (Imp.Code op) (State lore op) (Either InternalError) a)
   deriving (Functor, Applicative, Monad,
-            MonadState VNameSource,
+            MonadState (State lore op),
             MonadReader (Env lore op),
             MonadWriter (Imp.Code op),
             MonadError InternalError)
@@ -217,12 +231,11 @@
   fail = error . ("ImpM.fail: "++)
 
 instance MonadFreshNames (ImpM lore op) where
-  getNameSource = get
-  putNameSource = put
-
+  getNameSource = gets stateNameSource
+  putNameSource src = modify $ \s -> s { stateNameSource = src }
 
 instance HasScope SOACS (ImpM lore op) where
-  askScope = M.map (LetInfo . entryType) <$> asks envVtable
+  askScope = M.map (LetInfo . entryType) <$> gets stateVTable
     where entryType (MemVar _ memEntry) =
             Mem (dimSizeToSubExp $ entryMemSize memEntry) (entryMemSpace memEntry)
           entryType (ArrayVar _ arrayEntry) =
@@ -235,8 +248,10 @@
 
 runImpM :: ImpM lore op a
         -> Operations lore op -> Imp.Space -> VNameSource
-        -> Either InternalError (a, VNameSource, Imp.Code op)
-runImpM (ImpM m) comp = runRWST m . newEnv comp
+        -> Either InternalError (a, VNameSource, Imp.Code op, Imp.Functions op)
+runImpM (ImpM m) comp space src = do
+  (a, s, code) <- runRWST m (newEnv comp space) (newState src)
+  return (a, stateNameSource s, code, stateFunctions s)
 
 subImpM_ :: Operations lore' op' -> ImpM lore' op' a
          -> ImpM lore op (Imp.Code op')
@@ -246,17 +261,17 @@
         -> ImpM lore op (a, Imp.Code op')
 subImpM ops (ImpM m) = do
   env <- ask
-  src <- getNameSource
+  s <- get
   case runRWST m env { envExpCompiler = opsExpCompiler ops
-                     , envBodyCompiler = opsBodyCompiler ops
+                     , envStmsCompiler = opsStmsCompiler ops
                      , envCopyCompiler = opsCopyCompiler ops
                      , envOpCompiler = opsOpCompiler ops
-                     , envVtable = M.map scrubExps $ envVtable env
                      }
-       src of
+                 s { stateVTable = M.map scrubExps $ stateVTable s
+                   , stateFunctions = mempty } of
     Left err -> throwError err
-    Right (x, src', code) -> do
-      putNameSource src'
+    Right (x, s', code) -> do
+      putNameSource $ stateNameSource s'
       return (x, code)
   where scrubExps (ArrayVar _ entry) = ArrayVar Nothing entry
         scrubExps (MemVar _ entry) = MemVar Nothing entry
@@ -284,14 +299,25 @@
 emit :: Imp.Code op -> ImpM lore op ()
 emit = tell
 
+-- | Emit a function in the generated code.
+emitFunction :: Name -> Imp.Function op -> ImpM lore op ()
+emitFunction fname fun = do
+  Imp.Functions fs <- gets stateFunctions
+  modify $ \s -> s { stateFunctions = Imp.Functions $ (fname,fun) : fs }
+
+-- | Check if a function of a given name exists.
+hasFunction :: Name -> ImpM lore op Bool
+hasFunction fname = gets $ \s -> let Imp.Functions fs = stateFunctions s
+                                 in isJust $ lookup fname fs
+
 compileProg :: (ExplicitMemorish lore, MonadFreshNames m) =>
                Operations lore op -> Imp.Space
             -> Prog lore -> m (Either InternalError (Imp.Functions op))
-compileProg ops ds prog =
+compileProg ops space prog =
   modifyNameSource $ \src ->
-  case mapAccumLM (compileFunDef ops ds) src (progFunctions prog) of
+  case runImpM (mapM_ compileFunDef $ progFunctions prog) ops space src of
     Left err -> (Left err, src)
-    Right (src', funs) -> (Right $ Imp.Functions funs, src')
+    Right ((), src', _, fs) -> (Right fs, src')
 
 compileInParam :: ExplicitMemorish lore =>
                   FParam lore -> ImpM lore op (Either Imp.Param ArrayDecl)
@@ -319,8 +345,8 @@
 compileInParams params orig_epts = do
   let (ctx_params, val_params) =
         splitAt (length params - sum (map entryPointSize orig_epts)) params
-  (inparams, arraydecls) <- partitionEithers <$> mapM compileInParam (ctx_params++val_params)
-  let findArray x = find (isArrayDecl x) arraydecls
+  (inparams, arrayds) <- partitionEithers <$> mapM compileInParam (ctx_params++val_params)
+  let findArray x = find (isArrayDecl x) arrayds
       sizes = mconcat $ map fparamSizes $ ctx_params++val_params
 
       summaries = M.fromList $ mapMaybe memSummary params
@@ -361,7 +387,7 @@
         mkExts epts fparams
       mkExts _ _ = []
 
-  return (inparams, arraydecls, mkExts orig_epts val_params)
+  return (inparams, arrayds, mkExts orig_epts val_params)
   where isArrayDecl x (ArrayDecl y _ _) = x == y
 
 compileOutParams :: ExplicitMemorish lore =>
@@ -442,37 +468,36 @@
         ensureMemSizeOut (Free v) = imp $ subExpToDimSize v
 
 compileFunDef :: ExplicitMemorish lore =>
-                 Operations lore op -> Imp.Space
-              -> VNameSource
-              -> FunDef lore
-              -> Either InternalError (VNameSource, (Name, Imp.Function op))
-compileFunDef ops ds src (FunDef entry fname rettype params body) = do
-  ((outparams, inparams, results, args), src', body') <-
-    runImpM compile ops ds src
-  return (src',
-          (fname,
-           Imp.Function (isJust entry) outparams inparams body' results args))
+                 FunDef lore
+              -> ImpM lore op ()
+compileFunDef (FunDef entry fname rettype params body) = do
+  ((outparams, inparams, results, args), body') <- collect' compile
+  emitFunction fname $ Imp.Function (isJust entry) outparams inparams body' results args
   where params_entry = maybe (replicate (length params) TypeDirect) fst entry
         ret_entry = maybe (replicate (length rettype) TypeDirect) snd entry
         compile = do
-          (inparams, arraydecls, args) <- compileInParams params params_entry
-          (results, outparams, dests) <- compileOutParams rettype ret_entry
-          withFParams params $
-            withArrays arraydecls $
-            compileBody dests body
+          (inparams, arrayds, args) <- compileInParams params params_entry
+          (results, outparams, Destination _ dests) <- compileOutParams rettype ret_entry
+          addFParams params
+          addArrays arrayds
+
+          let Body _ stms ses = body
+          compileStms (freeIn ses) (stmsToList stms) $
+            forM_ (zip dests ses) $ \(d, se) -> copyDWIMDest d [] se []
+
           return (outparams, inparams, results, args)
 
-compileBody :: Destination -> Body lore -> ImpM lore op ()
-compileBody dest body = do
-  cb <- asks envBodyCompiler
-  cb dest body
+compileBody :: (ExplicitMemorish lore) => Pattern lore -> Body lore -> ImpM lore op ()
+compileBody pat (Body _ bnds ses) = do
+  Destination _ dests <- destinationFromPattern pat
+  compileStms (freeIn ses) (stmsToList bnds) $
+    forM_ (zip dests ses) $ \(d, se) -> copyDWIMDest d [] se []
 
-defCompileBody :: (ExplicitMemorish lore, FreeIn op) => Destination -> Body lore -> ImpM lore op ()
-defCompileBody (Destination _ dest) (Body _ bnds ses) =
-  compileStms (freeIn ses) (stmsToList bnds) $ zipWithM_ compileSubExpTo dest ses
+compileBody' :: (ExplicitMemorish lore, attr ~ LetAttr lore)
+             => [Param attr] -> Body lore -> ImpM lore op ()
+compileBody' = compileBody . patternFromParams
 
-compileLoopBody :: (ExplicitMemorish lore, FreeIn op) =>
-                   [VName] -> Body lore -> ImpM lore op (Imp.Code op)
+compileLoopBody :: [VName] -> Body lore -> ImpM lore op ()
 compileLoopBody mergenames (Body _ bnds ses) = do
   -- We cannot write the results to the merge parameters immediately,
   -- as some of the results may actually *be* merge parameters, and
@@ -481,7 +506,7 @@
   -- buffer to the merge parameters.  This is efficient, because the
   -- operations are all scalar operations.
   tmpnames <- mapM (newVName . (++"_tmp") . baseString) mergenames
-  collect $ compileStms (freeIn ses) (stmsToList bnds) $ do
+  compileStms (freeIn ses) (stmsToList bnds) $ do
     copy_to_merge_params <- forM (zip3 mergenames tmpnames ses) $ \(d,tmp,se) ->
       subExpType se >>= \case
         Prim bt  -> do
@@ -496,19 +521,23 @@
         _ -> return $ return ()
     sequence_ copy_to_merge_params
 
-compileStms :: (ExplicitMemorish lore, FreeIn op) =>
-               Names -> [Stm lore] -> ImpM lore op () -> ImpM lore op ()
-compileStms alive_after_stms all_stms m =
+compileStms :: Names -> [Stm lore] -> ImpM lore op () -> ImpM lore op ()
+compileStms alive_after_stms all_stms m = do
+  cb <- asks envStmsCompiler
+  cb alive_after_stms all_stms m
+
+defCompileStms :: (ExplicitMemorish lore, FreeIn op) =>
+                  Names -> [Stm lore] -> ImpM lore op () -> ImpM lore op ()
+defCompileStms alive_after_stms all_stms m =
   -- We keep track of any memory blocks produced by the statements,
   -- and after the last time that memory block is used, we insert a
   -- Free.  This is very conservative, but can cut down on lifetimes
   -- in some cases.
   void $ compileStms' mempty all_stms
-  where compileStms' allocs (Let pat _ e:bs) =
-          declaringVars (Just e) (patternElements pat) $ do
-          dest <- destinationFromPattern pat
+  where compileStms' allocs (Let pat _ e:bs) = do
+          dVars (Just e) (patternElements pat)
 
-          e_code <- collect $ compileExp dest e
+          e_code <- collect $ compileExp pat e
           (live_after, bs_code) <- collect' $ compileStms' (patternAllocs pat <> allocs) bs
           let dies_here v = not (v `S.member` live_after) &&
                             v `S.member` freeIn e_code
@@ -529,21 +558,22 @@
                             Mem _ space -> Just (patElemName pe, space)
                             _           -> Nothing
 
-compileExp :: Destination -> Exp lore -> ImpM lore op ()
-compileExp targets e = do
+compileExp :: Pattern lore -> Exp lore -> ImpM lore op ()
+compileExp pat e = do
   ec <- asks envExpCompiler
-  ec targets e
+  ec pat e
 
-defCompileExp :: (ExplicitMemorish lore, FreeIn op) =>
-                 Destination -> Exp lore -> ImpM lore op ()
+defCompileExp :: (ExplicitMemorish lore) =>
+                 Pattern lore -> Exp lore -> ImpM lore op ()
 
-defCompileExp dest (If cond tbranch fbranch _) = do
+defCompileExp pat (If cond tbranch fbranch _) = do
   cond' <- compileSubExp cond
-  tcode <- collect $ compileBody dest tbranch
-  fcode <- collect $ compileBody dest fbranch
+  tcode <- collect $ compileBody pat tbranch
+  fcode <- collect $ compileBody pat fbranch
   emit $ Imp.If cond' tcode fcode
 
-defCompileExp dest (Apply fname args _ _) = do
+defCompileExp pat (Apply fname args _ _) = do
+  dest <- destinationFromPattern pat
   targets <- funcallTargets dest
   args' <- catMaybes <$> mapM compileArg args
   emit $ Imp.Call targets fname args'
@@ -554,158 +584,141 @@
             (Var v, Mem{}) -> return $ Just $ Imp.MemArg v
             _              -> return Nothing
 
-defCompileExp targets (BasicOp op) = defCompileBasicOp targets op
+defCompileExp pat (BasicOp op) = defCompileBasicOp pat op
 
-defCompileExp (Destination _ dest) (DoLoop ctx val form body) =
-  declaringFParams mergepat $ do
-    forM_ merge $ \(p, se) -> do
-      na <- subExpNotArray se
-      when na $
-        copyDWIM (paramName p) [] se []
-    (bindForm, emitForm) <-
-      case form of
-        ForLoop i it bound loopvars -> do
-          bound' <- compileSubExp bound
-          let setLoopParam (p,a)
-                | Prim _ <- paramType p =
-                    copyDWIM (paramName p) [] (Var a) [varIndex i]
-                | otherwise =
-                    return ()
+defCompileExp pat (DoLoop ctx val form body) = do
+  dFParams mergepat
+  forM_ merge $ \(p, se) -> do
+    na <- subExpNotArray se
+    when na $
+      copyDWIM (paramName p) [] se []
 
-          let emitForm body' = do
-                set_loop_params <- collect $ mapM_ setLoopParam loopvars
-                emit $ Imp.For i it bound' $ set_loop_params<>body'
-          return (declaringLParams (map fst loopvars) .
-                  declaringLoopVar i it,
-                  emitForm)
-        WhileLoop cond ->
-          return (id, emit . Imp.While (Imp.var cond Bool))
+  let doBody = compileLoopBody mergenames body
 
-    bindForm $ do
-      body' <- compileLoopBody mergenames body
-      emitForm body'
-    zipWithM_ compileSubExpTo dest $ map (Var . paramName . fst) merge
-    where merge = ctx ++ val
-          mergepat = map fst merge
-          mergenames = map paramName mergepat
+  case form of
+    ForLoop i it bound loopvars -> do
+      bound' <- compileSubExp bound
 
-defCompileExp dest (Op op) = do
+      let setLoopParam (p,a)
+            | Prim _ <- paramType p =
+                copyDWIM (paramName p) [] (Var a) [varIndex i]
+            | otherwise =
+                return ()
+
+      dLParams $ map fst loopvars
+      sFor i it bound' $ mapM_ setLoopParam loopvars >> doBody
+    WhileLoop cond ->
+      sWhile (Imp.var cond Bool) doBody
+
+  Destination _ pat_dests <- destinationFromPattern pat
+  forM_ (zip pat_dests $ map (Var . paramName . fst) merge) $ \(d, r) ->
+    copyDWIMDest d [] r []
+
+  where merge = ctx ++ val
+        mergepat = map fst merge
+        mergenames = map paramName mergepat
+
+defCompileExp pat (Op op) = do
   opc <- asks envOpCompiler
-  opc dest op
+  opc pat op
 
-defCompileBasicOp :: Destination -> BasicOp lore -> ImpM lore op ()
+defCompileBasicOp :: ExplicitMemorish lore =>
+                     Pattern lore -> BasicOp lore -> ImpM lore op ()
 
-defCompileBasicOp (Destination _ [target]) (SubExp se) =
-  compileSubExpTo target se
+defCompileBasicOp (Pattern _ [pe]) (SubExp se) =
+  copyDWIM (patElemName pe) [] se []
 
-defCompileBasicOp (Destination _ [target]) (Opaque se) =
-  compileSubExpTo target se
+defCompileBasicOp (Pattern _ [pe]) (Opaque se) =
+  copyDWIM (patElemName pe) [] se []
 
-defCompileBasicOp (Destination _ [target]) (UnOp op e) = do
+defCompileBasicOp (Pattern _ [pe]) (UnOp op e) = do
   e' <- compileSubExp e
-  writeExp target $ Imp.UnOpExp op e'
+  patElemName pe <-- Imp.UnOpExp op e'
 
-defCompileBasicOp (Destination _ [target]) (ConvOp conv e) = do
+defCompileBasicOp (Pattern _ [pe]) (ConvOp conv e) = do
   e' <- compileSubExp e
-  writeExp target $ Imp.ConvOpExp conv e'
+  patElemName pe <-- Imp.ConvOpExp conv e'
 
-defCompileBasicOp (Destination _ [target]) (BinOp bop x y) = do
+defCompileBasicOp (Pattern _ [pe]) (BinOp bop x y) = do
   x' <- compileSubExp x
   y' <- compileSubExp y
-  writeExp target $ Imp.BinOpExp bop x' y'
+  patElemName pe <-- Imp.BinOpExp bop x' y'
 
-defCompileBasicOp (Destination _ [target]) (CmpOp bop x y) = do
+defCompileBasicOp (Pattern _ [pe]) (CmpOp bop x y) = do
   x' <- compileSubExp x
   y' <- compileSubExp y
-  writeExp target $ Imp.CmpOpExp bop x' y'
+  patElemName pe <-- Imp.CmpOpExp bop x' y'
 
-defCompileBasicOp (Destination _ [_]) (Assert e msg loc) = do
+defCompileBasicOp _ (Assert e msg loc) = do
   e' <- compileSubExp e
   msg' <- traverse compileSubExp msg
   emit $ Imp.Assert e' msg' loc
 
-defCompileBasicOp (Destination _ [target]) (Index src slice)
+defCompileBasicOp (Pattern _ [pe]) (Index src slice)
   | Just idxs <- sliceIndices slice =
-      copyDWIMDest target [] (Var src) $ map (compileSubExpOfType int32) idxs
+      copyDWIM (patElemName pe) [] (Var src) $ map (compileSubExpOfType int32) idxs
 
 defCompileBasicOp _ Index{} =
   return ()
 
-defCompileBasicOp (Destination _ [ArrayDestination (Just memloc)]) (Update _ slice se)
-  | MemLocation mem shape ixfun <- memloc = do
-    bt <- elemType <$> subExpType se
-    target' <-
-      case sliceIndices slice of
-        Just is -> do
-          (_, space, elemOffset) <-
-            fullyIndexArray'
-            (MemLocation mem shape ixfun)
-            (map (compileSubExpOfType int32) is)
-            bt
-          return $ ArrayElemDestination mem bt space elemOffset
-        Nothing ->
-          let memdest = sliceArray (MemLocation mem shape ixfun) $
-                        map (fmap (compileSubExpOfType int32)) slice
-          in return $ ArrayDestination $ Just memdest
-
-    copyDWIMDest target' [] se []
+defCompileBasicOp (Pattern _ [pe]) (Update _ slice se) = do
+  MemLocation mem shape ixfun <- entryArrayLocation <$> lookupArray (patElemName pe)
+  let memdest = sliceArray (MemLocation mem shape ixfun) $
+                map (fmap (compileSubExpOfType int32)) slice
+  copyDWIMDest (ArrayDestination $ Just memdest) [] se []
 
-defCompileBasicOp (Destination _ [dest]) (Replicate (Shape ds) se) = do
-  is <- replicateM (length ds) (newVName "i")
+defCompileBasicOp (Pattern _ [pe]) (Replicate (Shape ds) se) = do
   ds' <- mapM compileSubExp ds
-  declaringLoopVars Int32 is $ do
-    copy_elem <- collect $ copyDWIMDest dest (map varIndex is) se []
-    emit $ foldl (.) id (zipWith (`Imp.For` Int32) is ds') copy_elem
+  is <- replicateM (length ds) (newVName "i")
+  copy_elem <- collect $ copyDWIM (patElemName pe) (map varIndex is) se []
+  emit $ foldl (.) id (zipWith (`Imp.For` Int32) is ds') copy_elem
 
-defCompileBasicOp (Destination _ [_]) Scratch{} =
+defCompileBasicOp _ Scratch{} =
   return ()
 
-defCompileBasicOp (Destination _ [dest]) (Iota n e s et) = do
+defCompileBasicOp (Pattern [] [pe]) (Iota n e s et) = do
   i <- newVName "i"
   x <- newVName "x"
   n' <- compileSubExp n
   e' <- compileSubExp e
   s' <- compileSubExp s
-  emit $ Imp.DeclareScalar x $ IntType et
   let i' = ConvOpExp (SExt Int32 et) $ Imp.var i $ IntType Int32
-  declaringLoopVar i Int32 $ withPrimVar x (IntType et) $
-    emit =<< (Imp.For i Int32 n' <$>
-              collect (do emit $ Imp.SetScalar x $ e' + i' * s'
-                          copyDWIMDest dest [varIndex i] (Var x) []))
+  dPrim_ x $ IntType et
+  sFor i Int32 n' $ do
+    x <-- e' + i' * s'
+    copyDWIM (patElemName pe) [varIndex i] (Var x) []
 
-defCompileBasicOp (Destination _ [target]) (Copy src) =
-  compileSubExpTo target $ Var src
+defCompileBasicOp (Pattern _ [pe]) (Copy src) =
+  copyDWIM (patElemName pe) [] (Var src) []
 
-defCompileBasicOp (Destination _ [target]) (Manifest _ src) =
-  compileSubExpTo target $ Var src
+defCompileBasicOp (Pattern _ [pe]) (Manifest _ src) =
+  copyDWIM (patElemName pe) [] (Var src) []
 
-defCompileBasicOp
-  (Destination _ [ArrayDestination (Just (MemLocation destmem destshape destixfun))])
-  (Concat i x ys _) = do
+defCompileBasicOp (Pattern _ [pe]) (Concat i x ys _) = do
+    MemLocation destmem destshape destixfun <-
+      entryArrayLocation <$> lookupArray (patElemName pe)
     xtype <- lookupType x
-    offs_glb <- newVName "tmp_offs"
-    withPrimVar offs_glb int32 $ do
-      emit $ Imp.DeclareScalar offs_glb int32
-      emit $ Imp.SetScalar offs_glb 0
-      let perm = [i] ++ [0..i-1] ++ [i+1..length destshape-1]
-          invperm = rearrangeInverse perm
-          destloc = MemLocation destmem destshape
-                    (IxFun.permute (IxFun.offsetIndex (IxFun.permute destixfun perm) $
-                                    varIndex offs_glb)
-                     invperm)
+    offs_glb <- dPrim "tmp_offs" int32
+    emit $ Imp.SetScalar offs_glb 0
+    let perm = [i] ++ [0..i-1] ++ [i+1..length destshape-1]
+        invperm = rearrangeInverse perm
+        destloc = MemLocation destmem destshape
+                  (IxFun.permute (IxFun.offsetIndex (IxFun.permute destixfun perm) $
+                                  varIndex offs_glb)
+                   invperm)
 
-      forM_ (x:ys) $ \y -> do
-          yentry <- lookupArray y
-          let srcloc = entryArrayLocation yentry
-              rows = case drop i $ entryArrayShape yentry of
-                      []  -> error $ "defCompileBasicOp Concat: empty array shape for " ++ pretty y
-                      r:_ -> innerExp $ Imp.dimSizeToExp r
-          copy (elemType xtype) destloc srcloc $ arrayOuterSize yentry
-          emit $ Imp.SetScalar offs_glb $ Imp.var offs_glb int32 + rows
+    forM_ (x:ys) $ \y -> do
+      yentry <- lookupArray y
+      let srcloc = entryArrayLocation yentry
+          rows = case drop i $ entryArrayShape yentry of
+                  []  -> error $ "defCompileBasicOp Concat: empty array shape for " ++ pretty y
+                  r:_ -> innerExp $ Imp.dimSizeToExp r
+      copy (elemType xtype) destloc srcloc $ arrayOuterSize yentry
+      emit $ Imp.SetScalar offs_glb $ Imp.var offs_glb int32 + rows
 
-defCompileBasicOp (Destination _ [dest]) (ArrayLit es _)
-  | ArrayDestination (Just dest_mem) <- dest,
-    Just vs@(v:_) <- mapM isLiteral es = do
+defCompileBasicOp (Pattern [] [pe]) (ArrayLit es _)
+  | Just vs@(v:_) <- mapM isLiteral es = do
+      dest_mem <- entryArrayLocation <$> lookupArray (patElemName pe)
       dest_space <- entryMemSpace <$> lookupMemory (memLocationName dest_mem)
       let t = primValueType v
       static_array <- newVName "static_array"
@@ -714,11 +727,11 @@
                        IxFun.iota [fromIntegral $ length es]
           num_bytes = Imp.ConstSize $ fromIntegral (length es) * primByteSize t
           entry = MemVar Nothing $ MemEntry num_bytes dest_space
-      local (insertInVtable static_array entry) $
-        copy t dest_mem static_src $ fromIntegral $ length es
+      addVar static_array entry
+      copy t dest_mem static_src $ fromIntegral $ length es
   | otherwise =
     forM_ (zip [0..] es) $ \(i,e) ->
-      copyDWIMDest dest [constIndex i] e []
+      copyDWIM (patElemName pe) [constIndex i] e []
 
   where isLiteral (Constant v) = Just v
         isLiteral _ = Nothing
@@ -735,153 +748,58 @@
 defCompileBasicOp _ Repeat{} =
   return ()
 
-defCompileBasicOp (Destination _ dests) (Partition n flags value_arrs)
-  | (sizedests, arrdest) <- splitAt n dests,
-    Just sizenames <- mapM fromScalarDestination sizedests,
-    Just destlocs <- mapM arrDestLoc arrdest = do
-  i <- newVName "i"
-  declaringLoopVar i Int32 $ do
-    outer_dim <- compileSubExp =<< (arraySize 0 <$> lookupType flags)
-    -- We will use 'i' to index the flag array and the value array.
-    -- Note that they have the same outer size ('outer_dim').
-    read_flags_i <- readFromArray flags [varIndex i]
-
-    -- First, for each of the 'n' output arrays, we compute the final
-    -- size.  This is done by iterating through the flag array, but
-    -- first we declare scalars to hold the size.  We do this by
-    -- creating a mapping from equivalence classes to the name of the
-    -- scalar holding the size.
-    let sizes = M.fromList $ zip [0..n-1] sizenames
-
-    -- We initialise ecah size to zero.
-    forM_ sizenames $ \sizename ->
-      emit $ Imp.SetScalar sizename 0
-
-    -- Now iterate across the flag array, storing each element in
-    -- 'eqclass', then comparing it to the known classes and increasing
-    -- the appropriate size variable.
-    eqclass <- newVName "eqclass"
-    emit $ Imp.DeclareScalar eqclass int32
-    let mkSizeLoopBody code c sizevar =
-          Imp.If (Imp.CmpOpExp (CmpEq int32) (Imp.var eqclass int32) (fromIntegral c))
-          (Imp.SetScalar sizevar $ Imp.var sizevar int32 + 1)
-          code
-        sizeLoopBody = M.foldlWithKey' mkSizeLoopBody Imp.Skip sizes
-    emit $ Imp.For i Int32 outer_dim $
-      Imp.SetScalar eqclass read_flags_i <>
-      sizeLoopBody
-
-    -- We can now compute the starting offsets of each of the
-    -- partitions, creating a map from equivalence class to its
-    -- corresponding offset.
-    offsets <- flip evalStateT 0 $ forM sizes $ \size -> do
-      cur_offset <- get
-      partition_offset <- lift $ newVName "partition_offset"
-      lift $ emit $ Imp.DeclareScalar partition_offset int32
-      lift $ emit $ Imp.SetScalar partition_offset cur_offset
-      put $ Imp.var partition_offset int32 + Imp.var size int32
-      return partition_offset
-
-    -- We create the memory location we use when writing a result
-    -- element.  This is basically the index function of 'destloc', but
-    -- with a dynamic offset, stored in 'partition_cur_offset'.
-    partition_cur_offset <- newVName "partition_cur_offset"
-    emit $ Imp.DeclareScalar partition_cur_offset int32
-
-    -- Finally, we iterate through the data array and flag array in
-    -- parallel, and put each element where it is supposed to go.  Note
-    -- that after writing to a partition, we increase the corresponding
-    -- offset.
-    ets <- mapM (fmap elemType . lookupType) value_arrs
-    srclocs <- mapM arrayLocation value_arrs
-    copy_elements <- forM (zip3 destlocs ets srclocs) $ \(destloc,et,srcloc) ->
-      copyArrayDWIM et
-      destloc [varIndex partition_cur_offset]
-      srcloc [varIndex i]
-    let mkWriteLoopBody code c offsetvar =
-          Imp.If (Imp.CmpOpExp (CmpEq int32) (Imp.var eqclass int32) (fromIntegral c))
-          (Imp.SetScalar partition_cur_offset
-             (Imp.var offsetvar int32)
-           <>
-           mconcat copy_elements
-           <>
-           Imp.SetScalar offsetvar
-             (Imp.var offsetvar int32 + 1))
-          code
-        writeLoopBody = M.foldlWithKey' mkWriteLoopBody Imp.Skip offsets
-    emit $ Imp.For i Int32 outer_dim $
-      Imp.SetScalar eqclass read_flags_i <>
-      writeLoopBody
-    return ()
-  where arrDestLoc (ArrayDestination destloc) = destloc
-        arrDestLoc _ = Nothing
-
-defCompileBasicOp (Destination _ []) _ = return () -- No arms, no cake.
-
-defCompileBasicOp target e =
-  compilerBugS $ "ImpGen.defCompileBasicOp: Invalid target\n  " ++
-  show target ++ "\nfor expression\n  " ++ pretty e
-
-writeExp :: ValueDestination -> Imp.Exp -> ImpM lore op ()
-writeExp (ScalarDestination target) e =
-  emit $ Imp.SetScalar target e
-writeExp (ArrayElemDestination destmem bt space elemoffset) e = do
-  vol <- asks envVolatility
-  emit $ Imp.Write destmem elemoffset bt space vol e
-writeExp target e =
-  compilerBugS $ "Cannot write " ++ pretty e ++ " to " ++ show target
-
-insertInVtable :: VName -> VarEntry lore -> Env lore op -> Env lore op
-insertInVtable name entry env =
-  env { envVtable = M.insert name entry $ envVtable env }
-
-withArray :: ArrayDecl -> ImpM lore op a -> ImpM lore op a
-withArray (ArrayDecl name bt location) m = do
-  let entry = ArrayVar Nothing ArrayEntry
-              { entryArrayLocation = location
-              , entryArrayElemType = bt
-              }
-  local (insertInVtable name entry) m
+defCompileBasicOp pat e =
+  compilerBugS $ "ImpGen.defCompileBasicOp: Invalid pattern\n  " ++
+  pretty pat ++ "\nfor expression\n  " ++ pretty e
 
-withArrays :: [ArrayDecl] -> ImpM lore op a -> ImpM lore op a
-withArrays = flip $ foldr withArray
+-- | Note: a hack to be used only for functions.
+addArrays :: [ArrayDecl] -> ImpM lore op ()
+addArrays = mapM_ addArray
+  where addArray (ArrayDecl name bt location) =
+          addVar name $
+          ArrayVar Nothing ArrayEntry
+          { entryArrayLocation = location
+          , entryArrayElemType = bt
+          }
 
--- | Like 'declaringFParams', but does not create new declarations.
-withFParams :: ExplicitMemorish lore => [FParam lore] -> ImpM lore op a -> ImpM lore op a
-withFParams = flip $ foldr withFParam
-  where withFParam fparam m = do
+-- | Like 'daringFParams', but does not create new declarations.
+-- Note: a hack to be used only for functions.
+addFParams :: ExplicitMemorish lore => [FParam lore] -> ImpM lore op ()
+addFParams = mapM_ addFParam
+  where addFParam fparam = do
           entry <- memBoundToVarEntry Nothing $ noUniquenessReturns $ paramAttr fparam
-          local (insertInVtable (paramName fparam) entry) m
+          addVar (paramName fparam) entry
 
-declaringVars :: ExplicitMemorish lore =>
-                 Maybe (Exp lore) -> [PatElem lore] -> ImpM lore op a -> ImpM lore op a
-declaringVars e = flip $ foldr declaringVar
-  where declaringVar = declaringScope e . scopeOfPatElem
+-- | Another hack.
+addLoopVar :: VName -> IntType -> ImpM lore op ()
+addLoopVar i it = addVar i $ ScalarVar Nothing $ ScalarEntry $ IntType it
 
-declaringFParams :: ExplicitMemorish lore => [FParam lore] -> ImpM lore op a -> ImpM lore op a
-declaringFParams = declaringScope Nothing . scopeOfFParams
+dVars :: ExplicitMemorish lore =>
+            Maybe (Exp lore) -> [PatElem lore] -> ImpM lore op ()
+dVars e = mapM_ dVar
+  where dVar = dScope e . scopeOfPatElem
 
-declaringLParams :: ExplicitMemorish lore => [LParam lore] -> ImpM lore op a -> ImpM lore op a
-declaringLParams = declaringScope Nothing . scopeOfLParams
+dFParams :: ExplicitMemorish lore => [FParam lore] -> ImpM lore op ()
+dFParams = dScope Nothing . scopeOfFParams
 
-declaringVarEntry :: VName -> VarEntry lore -> ImpM lore op a -> ImpM lore op a
-declaringVarEntry name entry m = do
-  case entry of
-    MemVar _ entry' ->
-      emit $ Imp.DeclareMem name $ entryMemSpace entry'
-    ScalarVar _ entry' ->
-      emit $ Imp.DeclareScalar name $ entryScalarType entry'
-    ArrayVar _ _ ->
-      return ()
-  local (insertInVtable name entry) m
+dLParams :: ExplicitMemorish lore => [LParam lore] -> ImpM lore op ()
+dLParams = dScope Nothing . scopeOfLParams
 
-declaringPrimVar :: VName -> PrimType -> ImpM lore op a -> ImpM lore op a
-declaringPrimVar name bt =
-  declaringVarEntry name $ ScalarVar Nothing $ ScalarEntry bt
+dPrim_ :: VName -> PrimType -> ImpM lore op ()
+dPrim_ name t = do
+ emit $ Imp.DeclareScalar name t
+ addVar name $ ScalarVar Nothing $ ScalarEntry t
 
-declaringPrimVars :: [(VName,PrimType)] -> ImpM lore op a -> ImpM lore op a
-declaringPrimVars = flip $ foldr (uncurry declaringPrimVar)
+dPrim :: String -> PrimType -> ImpM lore op VName
+dPrim name t = do name' <- newVName name
+                  dPrim_ name' t
+                  return name'
 
+dPrimV :: String -> Imp.Exp -> ImpM lore op VName
+dPrimV name e = do name' <- dPrim name $ primExpType e
+                   name' <-- e
+                   return name'
+
 memBoundToVarEntry :: Maybe (Exp lore) -> MemBound NoUniqueness
                    -> ImpM lore op (VarEntry lore)
 memBoundToVarEntry e (MemPrim bt) =
@@ -898,32 +816,33 @@
                                  , entryArrayElemType = bt
                                  }
 
-declaringName :: Maybe (Exp lore) -> VName -> NameInfo ExplicitMemory
-              -> ImpM lore op a -> ImpM lore op a
-declaringName e name info m = do
+dInfo :: Maybe (Exp lore) -> VName -> NameInfo ExplicitMemory
+         -> ImpM lore op ()
+dInfo e name info = do
   entry <- memBoundToVarEntry e $ infoAttr info
-  declaringVarEntry name entry m
+  case entry of
+    MemVar _ entry' ->
+      emit $ Imp.DeclareMem name $ entryMemSpace entry'
+    ScalarVar _ entry' ->
+      emit $ Imp.DeclareScalar name $ entryScalarType entry'
+    ArrayVar _ _ ->
+      return ()
+  addVar name entry
   where infoAttr (LetInfo attr) = attr
         infoAttr (FParamInfo attr) = noUniquenessReturns attr
         infoAttr (LParamInfo attr) = attr
         infoAttr (IndexInfo it) = MemPrim $ IntType it
 
-declaringScope :: Maybe (Exp lore) -> Scope ExplicitMemory -> ImpM lore op a -> ImpM lore op a
-declaringScope e scope m = foldr (uncurry $ declaringName e) m $ M.toList scope
-
-declaringScopes :: [(Maybe (Exp lore), Scope ExplicitMemory)] -> ImpM lore op a -> ImpM lore op a
-declaringScopes es_and_scopes m = foldr (uncurry declaringScope) m es_and_scopes
-
-withPrimVar :: VName -> PrimType -> ImpM lore op a -> ImpM lore op a
-withPrimVar name bt =
-  local (insertInVtable name $ ScalarVar Nothing $ ScalarEntry bt)
+dScope :: Maybe (Exp lore) -> Scope ExplicitMemory -> ImpM lore op ()
+dScope e = mapM_ (uncurry $ dInfo e) . M.toList
 
-declaringLoopVars :: IntType -> [VName] -> ImpM lore op a -> ImpM lore op a
-declaringLoopVars it = flip $ foldr (`declaringLoopVar` it)
+dScopes :: [(Maybe (Exp lore), Scope ExplicitMemory)] -> ImpM lore op ()
+dScopes = mapM_ $ uncurry dScope
 
-declaringLoopVar :: VName -> IntType -> ImpM lore op a -> ImpM lore op a
-declaringLoopVar name it =
-  withPrimVar name $ IntType it
+dArray :: VName -> PrimType -> ShapeBase SubExp -> MemBind -> ImpM lore op ()
+dArray name bt shape membind = do
+  entry <- memBoundToVarEntry Nothing $ MemArray bt shape NoUniqueness membind
+  addVar name entry
 
 everythingVolatile :: ImpM lore op a -> ImpM lore op a
 everythingVolatile = local $ \env -> env { envVolatility = Imp.Volatile }
@@ -934,8 +853,6 @@
   concat <$> mapM funcallTarget dests
   where funcallTarget (ScalarDestination name) =
           return [name]
-        funcallTarget ArrayElemDestination{} =
-          compilerBugS "Cannot put scalar function return in-place yet." -- FIXME
         funcallTarget (ArrayDestination _) =
           return []
         funcallTarget (MemoryDestination name) =
@@ -951,8 +868,8 @@
 subExpToDimSize Constant{} =
   compilerBugS "Size subexp is not an int32 or int64 constant."
 
-compileSubExpTo :: ValueDestination -> SubExp -> ImpM lore op ()
-compileSubExpTo dest se = copyDWIMDest dest [] se []
+compileSubExpTo :: VName -> SubExp -> ImpM lore op ()
+compileSubExpTo d se = copyDWIM d [] se []
 
 compileSubExp :: SubExp -> ImpM lore op Imp.Exp
 compileSubExp (Constant v) =
@@ -976,9 +893,30 @@
 constIndex :: Int -> Imp.Exp
 constIndex = fromIntegral
 
+addVar :: VName -> VarEntry lore -> ImpM lore op ()
+addVar name entry =
+  modify $ \s -> s { stateVTable = M.insert name entry $ stateVTable s }
+
+-- | Get the current symbol table.
+getVTable :: ImpM lore op (VTable lore)
+getVTable = gets stateVTable
+
+putVTable :: VTable lore -> ImpM lore op ()
+putVTable vtable = modify $ \s -> s { stateVTable = vtable }
+
+-- | Run an action with a modified symbol table.  All changes to the
+-- symbol table will be reverted once the action is done!
+localVTable :: (VTable lore -> VTable lore) -> ImpM lore op a -> ImpM lore op a
+localVTable f m = do
+  old_vtable <- getVTable
+  putVTable $ f old_vtable
+  a <- m
+  putVTable old_vtable
+  return a
+
 lookupVar :: VName -> ImpM lore op (VarEntry lore)
 lookupVar name = do
-  res <- asks $ M.lookup name . envVtable
+  res <- gets $ M.lookup name . stateVTable
   case res of
     Just entry -> return entry
     _ -> compilerBugS $ "Unknown variable: " ++ pretty name
@@ -990,9 +928,6 @@
     ArrayVar _ entry -> return entry
     _                -> compilerBugS $ "ImpGen.lookupArray: not an array: " ++ pretty name
 
-arrayLocation :: VName -> ImpM lore op MemLocation
-arrayLocation name = entryArrayLocation <$> lookupArray name
-
 lookupMemory :: VName -> ImpM lore op MemEntry
 lookupMemory name = do
   res <- lookupVar name
@@ -1000,19 +935,6 @@
     MemVar _ entry -> return entry
     _              -> compilerBugS $ "Unknown memory block: " ++ pretty name
 
-destinationFromParam :: Param (MemBound u) -> ImpM lore op ValueDestination
-destinationFromParam param
-  | MemArray _ shape _ (ArrayIn mem ixfun) <- paramAttr param = do
-      let dims = shapeDims shape
-      memloc <- MemLocation mem <$> mapM subExpToDimSize dims <*>
-                pure (fmap compilePrimExp ixfun)
-      return $ ArrayDestination $ Just memloc
-  | otherwise =
-      return $ ScalarDestination $ paramName param
-
-destinationFromParams :: [Param (MemBound u)] -> ImpM lore op Destination
-destinationFromParams ps = fmap (Destination $ baseTag . paramName <$> maybeHead ps) . mapM destinationFromParam $ ps
-
 destinationFromPattern :: ExplicitMemorish lore => Pattern lore -> ImpM lore op Destination
 destinationFromPattern pat = fmap (Destination (baseTag <$> maybeHead (patternNames pat))) . mapM inspect $
                              patternElements pat
@@ -1045,15 +967,6 @@
   return (mem, space,
           bytes $ IxFun.index ixfun indices $ primByteSize bt)
 
-readFromArray :: VName -> [Imp.Exp]
-              -> ImpM lore op Imp.Exp
-readFromArray name indices = do
-  arr <- lookupArray name
-  (mem, space, i) <-
-    fullyIndexArray' (entryArrayLocation arr) indices $ entryArrayElemType arr
-  vol <- asks envVolatility
-  return $ Imp.index mem i (entryArrayElemType arr) space vol
-
 sliceArray :: MemLocation
            -> Slice Imp.Exp
            -> MemLocation
@@ -1090,9 +1003,9 @@
 -- More complicated read/write operations that use index functions.
 
 copy :: CopyCompiler lore op
-copy bt dest src n = do
+copy bt pat src n = do
   cc <- asks envCopyCompiler
-  cc bt dest src n
+  cc bt pat src n
 
 -- | Use an 'Imp.Copy' if possible, otherwise 'copyElementWise'.
 defaultCopy :: CopyCompiler lore op
@@ -1121,17 +1034,16 @@
 copyElementWise :: CopyCompiler lore op
 copyElementWise bt (MemLocation destmem _ destIxFun) (MemLocation srcmem srcshape srcIxFun) n = do
     is <- replicateM (IxFun.rank destIxFun) (newVName "i")
-    declaringLoopVars Int32 is $ do
-      let ivars = map varIndex is
-          destidx = IxFun.index destIxFun ivars bt_size
-          srcidx = IxFun.index srcIxFun ivars bt_size
-          bounds = map innerExp $ n : drop 1 (map Imp.dimSizeToExp srcshape)
-      srcspace <- entryMemSpace <$> lookupMemory srcmem
-      destspace <- entryMemSpace <$> lookupMemory destmem
-      vol <- asks envVolatility
-      emit $ foldl (.) id (zipWith (`Imp.For` Int32) is bounds) $
-        Imp.Write destmem (bytes destidx) bt destspace vol $
-        Imp.index srcmem (bytes srcidx) bt srcspace vol
+    let ivars = map varIndex is
+        destidx = IxFun.index destIxFun ivars bt_size
+        srcidx = IxFun.index srcIxFun ivars bt_size
+        bounds = map innerExp $ n : drop 1 (map Imp.dimSizeToExp srcshape)
+    srcspace <- entryMemSpace <$> lookupMemory srcmem
+    destspace <- entryMemSpace <$> lookupMemory destmem
+    vol <- asks envVolatility
+    emit $ foldl (.) id (zipWith (`Imp.For` Int32) is bounds) $
+      Imp.Write destmem (bytes destidx) bt destspace vol $
+      Imp.index srcmem (bytes srcidx) bt srcspace vol
   where bt_size = primByteSize bt
 
 -- | Copy from here to there; both destination and source may be
@@ -1174,13 +1086,10 @@
 copyDWIMDest _ _ (Constant v) (_:_) =
   compilerBugS $
   unwords ["copyDWIMDest: constant source", pretty v, "cannot be indexed."]
-copyDWIMDest dest dest_is (Constant v) [] =
-  case dest of
+copyDWIMDest pat dest_is (Constant v) [] =
+  case pat of
   ScalarDestination name ->
     emit $ Imp.SetScalar name $ Imp.ValueExp v
-  ArrayElemDestination dest_mem _ dest_space dest_i -> do
-    vol <- asks envVolatility
-    emit $ Imp.Write dest_mem dest_i bt dest_space vol $ Imp.ValueExp v
   MemoryDestination{} ->
     compilerBugS $
     unwords ["copyDWIMDest: constant source", pretty v, "cannot be written to memory destination."]
@@ -1226,30 +1135,6 @@
       vol <- asks envVolatility
       emit $ Imp.SetScalar name $ Imp.index mem i bt space vol
 
-    (ArrayElemDestination{}, _) | not $ null dest_is->
-      compilerBugS $
-      unwords ["copyDWIMDest: array elemenent destination given indices:", pretty dest_is]
-
-    (ArrayElemDestination dest_mem _ dest_space dest_i,
-     ScalarVar _ (ScalarEntry bt)) -> do
-      vol <- asks envVolatility
-      emit $ Imp.Write dest_mem dest_i bt dest_space vol $ Imp.var src bt
-
-    (ArrayElemDestination dest_mem _ dest_space dest_i, ArrayVar _ src_arr)
-      | length (entryArrayShape src_arr) == length src_is -> do
-          let bt = entryArrayElemType src_arr
-          (src_mem, src_space, src_i) <-
-            fullyIndexArray' (entryArrayLocation src_arr) src_is bt
-          vol <- asks envVolatility
-          emit $ Imp.Write dest_mem dest_i bt dest_space vol $
-            Imp.index src_mem src_i bt src_space vol
-
-    (ArrayElemDestination{}, ArrayVar{}) ->
-      compilerBugS $
-      unwords ["copyDWIMDest: array element destination, but array source",
-               pretty src,
-               "with incomplete indexing."]
-
     (ArrayDestination (Just dest_loc), ArrayVar _ src_arr) -> do
       let src_loc = entryArrayLocation src_arr
           bt = entryArrayElemType src_arr
@@ -1285,16 +1170,17 @@
             MemoryDestination dest
   copyDWIMDest dest_target dest_is src src_is
 
--- | @compileAlloc dest size space@ allocates @n@ bytes of memory in @space@,
+-- | @compileAlloc pat size space@ allocates @n@ bytes of memory in @space@,
 -- writing the result to @dest@, which must be a single
 -- 'MemoryDestination',
-compileAlloc :: Destination -> SubExp -> Space
+compileAlloc :: ExplicitMemorish lore =>
+                Pattern lore -> SubExp -> Space
              -> ImpM lore op ()
-compileAlloc (Destination _ [MemoryDestination mem]) e space = do
+compileAlloc (Pattern [] [mem]) e space = do
   e' <- compileSubExp e
-  emit $ Imp.Allocate mem (Imp.bytes e') space
-compileAlloc dest _ _ =
-  compilerBugS $ "compileAlloc: Invalid destination: " ++ show dest
+  emit $ Imp.Allocate (patElemName mem) (Imp.bytes e') space
+compileAlloc pat _ _ =
+  compilerBugS $ "compileAlloc: Invalid pattern: " ++ pretty pat
 
 dimSizeToSubExp :: Imp.Size -> SubExp
 dimSizeToSubExp (Imp.ConstSize n) = constant n
@@ -1302,3 +1188,67 @@
 
 dimSizeToExp :: Imp.Size -> Imp.Exp
 dimSizeToExp = compilePrimExp . primExpFromSubExp int32 . dimSizeToSubExp
+
+--- Building blocks for constructing code.
+
+sFor :: VName -> IntType -> Imp.Exp -> ImpM lore op () -> ImpM lore op ()
+sFor i it bound body = do
+  addLoopVar i it
+  body' <- collect body
+  emit $ Imp.For i it bound body'
+
+sWhile :: Imp.Exp -> ImpM lore op () -> ImpM lore op ()
+sWhile cond body = do
+  body' <- collect body
+  emit $ Imp.While cond body'
+
+sComment :: String -> ImpM lore op () -> ImpM lore op ()
+sComment s code = do
+  code' <- collect code
+  emit $ Imp.Comment s code'
+
+sIf :: Imp.Exp -> ImpM lore op () -> ImpM lore op () -> ImpM lore op ()
+sIf cond tbranch fbranch = do
+  tbranch' <- collect tbranch
+  fbranch' <- collect fbranch
+  emit $ Imp.If cond tbranch' fbranch'
+
+sWhen :: Imp.Exp -> ImpM lore op () -> ImpM lore op ()
+sWhen cond tbranch = sIf cond tbranch (return ())
+
+sUnless :: Imp.Exp -> ImpM lore op () -> ImpM lore op ()
+sUnless cond = sIf cond (return ())
+
+sOp :: op -> ImpM lore op ()
+sOp = emit . Imp.Op
+
+sAlloc :: String -> Count Bytes -> Space -> ImpM lore op VName
+sAlloc name size space = do
+  name' <- newVName name
+  size' <- case Imp.innerExp size of
+             Imp.LeafExp (Imp.ScalarVar size') _ -> return $ Imp.VarSize size'
+             Imp.ValueExp (IntValue (Int64Value v)) -> return $ Imp.ConstSize v
+             _ -> do size_var <- dPrim "local_buf_size" int32
+                     size_var <-- Imp.innerExp size
+                     return $ Imp.VarSize size_var
+  emit $ Imp.DeclareMem name' space
+  emit $ Imp.Allocate name' size space
+  addVar name' $ MemVar Nothing $ MemEntry size' space
+  return name'
+
+sArray :: String -> PrimType -> ShapeBase SubExp -> MemBind -> ImpM lore op VName
+sArray name bt shape membind = do
+  name' <- newVName name
+  dArray name' bt shape membind
+  return name'
+
+sWrite :: VName -> [Imp.Exp] -> PrimExp Imp.ExpLeaf -> ImpM lore op ()
+sWrite arr is v = do
+  (mem, space, offset) <- fullyIndexArray arr is
+  vol <- asks envVolatility
+  emit $ Imp.Write mem offset (primExpType v) space vol v
+
+-- | ASsignment.
+(<--) :: VName -> Imp.Exp -> ImpM lore op ()
+x <-- e = emit $ Imp.SetScalar x e
+infixl 3 <--
diff --git a/src/Futhark/CodeGen/ImpGen/Kernels.hs b/src/Futhark/CodeGen/ImpGen/Kernels.hs
--- a/src/Futhark/CodeGen/ImpGen/Kernels.hs
+++ b/src/Futhark/CodeGen/ImpGen/Kernels.hs
@@ -26,1346 +26,1305 @@
 import qualified Futhark.CodeGen.ImpCode.Kernels as Imp
 import Futhark.CodeGen.ImpCode.Kernels (bytes)
 import qualified Futhark.CodeGen.ImpGen as ImpGen
-import qualified Futhark.Representation.ExplicitMemory.IndexFunction as IxFun
-import Futhark.CodeGen.SetDefaultSpace
-import Futhark.Tools (partitionChunkedKernelLambdaParameters, fullSliceNum)
-import Futhark.Util.IntegralExp (quotRoundingUp, quot, rem, IntegralExp)
-import Futhark.Util (splitAt3)
-
-type CallKernelGen = ImpGen.ImpM ExplicitMemory Imp.HostOp
-type InKernelGen = ImpGen.ImpM InKernel Imp.KernelOp
-
-callKernelOperations :: ImpGen.Operations ExplicitMemory Imp.HostOp
-callKernelOperations =
-  ImpGen.Operations { ImpGen.opsExpCompiler = expCompiler
-                    , ImpGen.opsCopyCompiler = callKernelCopy
-                    , ImpGen.opsOpCompiler = opCompiler
-                    , ImpGen.opsBodyCompiler = ImpGen.defCompileBody
-                    }
-
-inKernelOperations :: KernelConstants -> ImpGen.Operations InKernel Imp.KernelOp
-inKernelOperations constants = (ImpGen.defaultOperations $ compileInKernelOp constants)
-                               { ImpGen.opsCopyCompiler = inKernelCopy
-                               , ImpGen.opsExpCompiler = inKernelExpCompiler
-                               , ImpGen.opsBodyCompiler = compileNestedKernelBody constants
-                               }
-
-compileProg :: MonadFreshNames m => Prog ExplicitMemory -> m (Either InternalError Imp.Program)
-compileProg prog =
-  fmap (setDefaultSpace (Imp.Space "device")) <$>
-  ImpGen.compileProg callKernelOperations (Imp.Space "device") prog
-
-opCompiler :: ImpGen.Destination -> Op ExplicitMemory
-           -> CallKernelGen ()
-opCompiler dest (Alloc e space) =
-  ImpGen.compileAlloc dest e space
-opCompiler dest (Inner kernel) =
-  kernelCompiler dest kernel
-
-compileInKernelOp :: KernelConstants -> ImpGen.Destination -> Op InKernel
-                  -> InKernelGen ()
-compileInKernelOp _ (ImpGen.Destination _ [ImpGen.MemoryDestination mem]) Alloc{} =
-  compilerLimitationS $ "Cannot allocate memory block " ++ pretty mem ++ " in kernel."
-compileInKernelOp _ dest Alloc{} =
-  compilerBugS $ "Invalid target for in-kernel allocation: " ++ show dest
-compileInKernelOp constants dest (Inner op) =
-  compileKernelExp constants dest op
-
--- | Recognise kernels (maps), give everything else back.
-kernelCompiler :: ImpGen.Destination -> Kernel InKernel
-               -> CallKernelGen ()
-
-kernelCompiler dest (GetSize key size_class) = do
-  [v] <- ImpGen.funcallTargets dest
-  ImpGen.emit $ Imp.Op $ Imp.GetSize v key size_class
-
-kernelCompiler dest (CmpSizeLe key size_class x) = do
-  [v] <- ImpGen.funcallTargets dest
-  ImpGen.emit =<< Imp.Op . Imp.CmpSizeLe v key size_class <$> ImpGen.compileSubExp x
-
-kernelCompiler dest (GetSizeMax size_class) = do
-  [v] <- ImpGen.funcallTargets dest
-  ImpGen.emit $ Imp.Op $ Imp.GetSizeMax v size_class
-
-kernelCompiler dest (Kernel desc space _ kernel_body) = do
-
-  num_groups' <- ImpGen.subExpToDimSize $ spaceNumGroups space
-  group_size' <- ImpGen.subExpToDimSize $ spaceGroupSize space
-  num_threads' <- ImpGen.subExpToDimSize $ spaceNumThreads space
-
-  let bound_in_kernel =
-        M.keys $
-        scopeOfKernelSpace space <>
-        scopeOf (kernelBodyStms kernel_body)
-
-  let global_tid = spaceGlobalId space
-      local_tid = spaceLocalId space
-      group_id = spaceGroupId space
-  wave_size <- newVName "wave_size"
-  inner_group_size <- newVName "group_size"
-  thread_active <- newVName "thread_active"
-
-  let (space_is, space_dims) = unzip $ spaceDimensions space
-  space_dims' <- mapM ImpGen.compileSubExp space_dims
-  let constants = KernelConstants global_tid local_tid group_id
-                  group_size' num_threads'
-                  (Imp.VarSize wave_size) (zip space_is space_dims')
-                  (Imp.var thread_active Bool) mempty
-
-  kernel_body' <-
-    makeAllMemoryGlobal $
-    ImpGen.subImpM_ (inKernelOperations constants) $
-    ImpGen.declaringPrimVar wave_size int32 $
-    ImpGen.declaringPrimVar inner_group_size int32 $
-    ImpGen.declaringPrimVar thread_active Bool $
-    ImpGen.declaringScope Nothing (scopeOfKernelSpace space) $ do
-
-    ImpGen.emit $
-      Imp.Op (Imp.GetGlobalId global_tid 0) <>
-      Imp.Op (Imp.GetLocalId local_tid 0) <>
-      Imp.Op (Imp.GetLocalSize inner_group_size 0) <>
-      Imp.Op (Imp.GetLockstepWidth wave_size) <>
-      Imp.Op (Imp.GetGroupId group_id 0)
-
-    setSpaceIndices space
-
-    ImpGen.emit $ Imp.SetScalar thread_active (isActive $ spaceDimensions space)
-
-    compileKernelBody dest constants kernel_body
-
-  (uses, local_memory) <- computeKernelUses kernel_body' bound_in_kernel
-
-  forM_ (kernelHints desc) $ \(s,v) -> do
-    ty <- case v of
-      Constant pv -> return $ Prim $ primValueType pv
-      Var vn -> lookupType vn
-    unless (primType ty) $ fail $ concat [ "debugKernelHint '", s, "'"
-                                         , " in kernel '", kernelName desc, "'"
-                                         , " did not have primType value." ]
-
-    ImpGen.compileSubExp v >>= ImpGen.emit . Imp.DebugPrint s (elemType ty)
-
-  ImpGen.emit $ Imp.Op $ Imp.CallKernel $ Imp.AnyKernel Imp.Kernel
-            { Imp.kernelBody = kernel_body'
-            , Imp.kernelLocalMemory = local_memory
-            , Imp.kernelUses = uses
-            , Imp.kernelNumGroups = num_groups'
-            , Imp.kernelGroupSize = group_size'
-            , Imp.kernelName = global_tid
-            , Imp.kernelDesc = kernelName desc
-            }
-
-expCompiler :: ImpGen.ExpCompiler ExplicitMemory Imp.HostOp
--- We generate a simple kernel for itoa and replicate.
-expCompiler
-  (ImpGen.Destination tag [ImpGen.ArrayDestination (Just destloc)])
-  (BasicOp (Iota n x s et)) = do
-  thread_gid <- maybe (newVName "thread_gid") (return . VName (nameFromString "thread_gid")) tag
-
-  makeAllMemoryGlobal $ do
-    (destmem, destspace, destidx) <-
-      ImpGen.fullyIndexArray' destloc [ImpGen.varIndex thread_gid] (IntType et)
-
-    n' <- ImpGen.compileSubExp n
-    x' <- ImpGen.compileSubExp x
-    s' <- ImpGen.compileSubExp s
-
-    let body = Imp.Write destmem destidx (IntType et) destspace Imp.Nonvolatile $
-               Imp.ConvOpExp (SExt Int32 et) (Imp.var thread_gid int32) * s' + x'
-
-    (group_size, num_groups) <- computeMapKernelGroups n'
-
-    (body_uses, _) <- computeKernelUses
-                      (freeIn body <> freeIn [n',x',s'])
-                      [thread_gid]
-
-    ImpGen.emit $ Imp.Op $ Imp.CallKernel $ Imp.Map Imp.MapKernel
-      { Imp.mapKernelThreadNum = thread_gid
-      , Imp.mapKernelDesc = "iota"
-      , Imp.mapKernelNumGroups = Imp.VarSize num_groups
-      , Imp.mapKernelGroupSize = Imp.VarSize group_size
-      , Imp.mapKernelSize = n'
-      , Imp.mapKernelUses = body_uses
-      , Imp.mapKernelBody = body
-      }
-
-expCompiler
-  (ImpGen.Destination tag [dest]) (BasicOp (Replicate (Shape ds) se)) = do
-  constants <- simpleKernelConstants tag "replicate"
-
-  t <- subExpType se
-  let thread_gid = kernelGlobalThreadId constants
-      row_dims = arrayDims t
-      dims = ds ++ row_dims
-      is' = unflattenIndex (map (ImpGen.compileSubExpOfType int32) dims) $
-            ImpGen.varIndex thread_gid
-  ds' <- mapM ImpGen.compileSubExp ds
-
-  makeAllMemoryGlobal $ do
-    body <- ImpGen.subImpM_ (inKernelOperations constants) $
-      ImpGen.copyDWIMDest dest is' se $ drop (length ds) is'
-
-    dims' <- mapM ImpGen.compileSubExp dims
-    (group_size, num_groups) <- computeMapKernelGroups $ product dims'
-
-    (body_uses, _) <- computeKernelUses
-                      (freeIn body <> freeIn ds')
-                      [thread_gid]
-
-    ImpGen.emit $ Imp.Op $ Imp.CallKernel $ Imp.Map Imp.MapKernel
-      { Imp.mapKernelThreadNum = thread_gid
-      , Imp.mapKernelDesc = "replicate"
-      , Imp.mapKernelNumGroups = Imp.VarSize num_groups
-      , Imp.mapKernelGroupSize = Imp.VarSize group_size
-      , Imp.mapKernelSize = product dims'
-      , Imp.mapKernelUses = body_uses
-      , Imp.mapKernelBody = body
-      }
-
--- Allocation in the "local" space is just a placeholder.
-expCompiler _ (Op (Alloc _ (Space "local"))) =
-  return ()
-
-expCompiler dest e =
-  ImpGen.defCompileExp dest e
-
-callKernelCopy :: ImpGen.CopyCompiler ExplicitMemory Imp.HostOp
-callKernelCopy bt
-  destloc@(ImpGen.MemLocation destmem destshape destIxFun)
-  srcloc@(ImpGen.MemLocation srcmem srcshape srcIxFun)
-  n
-  | Just (destoffset, srcoffset,
-          num_arrays, size_x, size_y,
-          src_elems, dest_elems) <- isMapTransposeKernel bt destloc srcloc =
-  ImpGen.emit $ Imp.Op $ Imp.CallKernel $
-  Imp.MapTranspose bt
-  destmem destoffset
-  srcmem srcoffset
-  num_arrays size_x size_y
-  src_elems dest_elems
-
-  | bt_size <- primByteSize bt,
-    ixFunMatchesInnerShape
-      (Shape $ map Imp.sizeToExp destshape) destIxFun,
-    ixFunMatchesInnerShape
-      (Shape $ map Imp.sizeToExp srcshape) srcIxFun,
-    Just destoffset <-
-      IxFun.linearWithOffset destIxFun bt_size,
-    Just srcoffset  <-
-      IxFun.linearWithOffset srcIxFun bt_size = do
-        let row_size = product $ map ImpGen.dimSizeToExp $ drop 1 srcshape
-        srcspace <- ImpGen.entryMemSpace <$> ImpGen.lookupMemory srcmem
-        destspace <- ImpGen.entryMemSpace <$> ImpGen.lookupMemory destmem
-        ImpGen.emit $ Imp.Copy
-          destmem (bytes destoffset) destspace
-          srcmem (bytes srcoffset) srcspace $
-          (n * row_size) `Imp.withElemType` bt
-
-  | otherwise = do
-  global_thread_index <- newVName "copy_global_thread_index"
-
-  -- Note that the shape of the destination and the source are
-  -- necessarily the same.
-  let shape = map Imp.sizeToExp srcshape
-      shape_se = map (Imp.innerExp . ImpGen.dimSizeToExp) srcshape
-      dest_is = unflattenIndex shape_se $ ImpGen.varIndex global_thread_index
-      src_is = dest_is
-
-  makeAllMemoryGlobal $ do
-    (_, destspace, destidx) <- ImpGen.fullyIndexArray' destloc dest_is bt
-    (_, srcspace, srcidx) <- ImpGen.fullyIndexArray' srcloc src_is bt
-
-    let body = Imp.Write destmem destidx bt destspace Imp.Nonvolatile $
-               Imp.index srcmem srcidx bt srcspace Imp.Nonvolatile
-
-    destmem_size <- ImpGen.entryMemSize <$> ImpGen.lookupMemory destmem
-    let writes_to = [Imp.MemoryUse destmem destmem_size]
-
-    reads_from <- readsFromSet $
-                  S.singleton srcmem <>
-                  freeIn destIxFun <> freeIn srcIxFun <> freeIn destshape
-
-    let kernel_size = Imp.innerExp n * product (drop 1 shape)
-    (group_size, num_groups) <- computeMapKernelGroups kernel_size
-
-    let bound_in_kernel = [global_thread_index]
-    (body_uses, _) <- computeKernelUses (kernel_size, body) bound_in_kernel
-
-    ImpGen.emit $ Imp.Op $ Imp.CallKernel $ Imp.Map Imp.MapKernel
-      { Imp.mapKernelThreadNum = global_thread_index
-      , Imp.mapKernelDesc = "copy"
-      , Imp.mapKernelNumGroups = Imp.VarSize num_groups
-      , Imp.mapKernelGroupSize = Imp.VarSize group_size
-      , Imp.mapKernelSize = kernel_size
-      , Imp.mapKernelUses = nub $ body_uses ++ writes_to ++ reads_from
-      , Imp.mapKernelBody = body
-      }
-
--- | We have no bulk copy operation (e.g. memmove) inside kernels, so
--- turn any copy into a loop.
-inKernelCopy :: ImpGen.CopyCompiler InKernel Imp.KernelOp
-inKernelCopy = ImpGen.copyElementWise
-
-inKernelExpCompiler :: ImpGen.ExpCompiler InKernel Imp.KernelOp
-inKernelExpCompiler _ (BasicOp (Assert _ _ (loc, locs))) =
-  compilerLimitationS $
-  unlines [ "Cannot compile assertion at " ++
-            intercalate " -> " (reverse $ map locStr $ loc:locs) ++
-            " inside parallel kernel."
-          , "As a workaround, surround the expression with 'unsafe'."]
--- The static arrays stuff does not work inside kernels.
-inKernelExpCompiler (ImpGen.Destination _ [dest]) (BasicOp (ArrayLit es _)) =
-  forM_ (zip [0..] es) $ \(i,e) ->
-  ImpGen.copyDWIMDest dest [fromIntegral (i::Int32)] e []
-inKernelExpCompiler dest e =
-  ImpGen.defCompileExp dest e
-
-computeKernelUses :: FreeIn a =>
-                     a -> [VName]
-                  -> CallKernelGen ([Imp.KernelUse], [Imp.LocalMemoryUse])
-computeKernelUses kernel_body bound_in_kernel = do
-    let actually_free = freeIn kernel_body `S.difference` S.fromList bound_in_kernel
-
-    -- Compute the variables that we need to pass to the kernel.
-    reads_from <- readsFromSet actually_free
-
-    -- Are we using any local memory?
-    local_memory <- computeLocalMemoryUse actually_free
-    return (nub reads_from, nub local_memory)
-
-readsFromSet :: Names -> CallKernelGen [Imp.KernelUse]
-readsFromSet free =
-  fmap catMaybes $
-  forM (S.toList free) $ \var -> do
-    t <- lookupType var
-    case t of
-      Array {} -> return Nothing
-      Mem _ (Space "local") -> return Nothing
-      Mem memsize _ -> Just <$> (Imp.MemoryUse var <$>
-                                 ImpGen.subExpToDimSize memsize)
-      Prim bt ->
-        isConstExp var >>= \case
-          Just ce -> return $ Just $ Imp.ConstUse var ce
-          Nothing | bt == Cert -> return Nothing
-                  | otherwise  -> return $ Just $ Imp.ScalarUse var bt
-
-computeLocalMemoryUse :: Names -> CallKernelGen [Imp.LocalMemoryUse]
-computeLocalMemoryUse free =
-  fmap catMaybes $
-  forM (S.toList free) $ \var -> do
-    t <- lookupType var
-    case t of
-      Mem memsize (Space "local") -> do
-        memsize' <- localMemSize =<< ImpGen.subExpToDimSize memsize
-        return $ Just (var, memsize')
-      _ -> return Nothing
-
-localMemSize :: Imp.MemSize -> CallKernelGen (Either Imp.MemSize Imp.KernelConstExp)
-localMemSize (Imp.ConstSize x) =
-  return $ Right $ ValueExp $ IntValue $ Int64Value x
-localMemSize (Imp.VarSize v) = isConstExp v >>= \case
-  Just e | isStaticExp e -> return $ Right e
-  _ -> return $ Left $ Imp.VarSize v
-
--- | Only some constant expressions quality as *static* expressions,
--- which we can use for static memory allocation.  This is a bit of a
--- hack, as it is primarly motivated by what you can put as the size
--- when declaring an array in C.
-isStaticExp :: Imp.KernelConstExp -> Bool
-isStaticExp LeafExp{} = True
-isStaticExp ValueExp{} = True
-isStaticExp (BinOpExp Add{} x y) = isStaticExp x && isStaticExp y
-isStaticExp (BinOpExp Sub{} x y) = isStaticExp x && isStaticExp y
-isStaticExp (BinOpExp Mul{} x y) = isStaticExp x && isStaticExp y
-isStaticExp _ = False
-
-isConstExp :: VName -> CallKernelGen (Maybe Imp.KernelConstExp)
-isConstExp v = do
-  vtable <- asks ImpGen.envVtable
-  let lookupConstExp name = constExp =<< hasExp =<< M.lookup name vtable
-      constExp (Op (Inner (GetSize key _))) = Just $ LeafExp (Imp.SizeConst key) int32
-      constExp e = primExpFromExp lookupConstExp e
-  return $ lookupConstExp v
-  where hasExp (ImpGen.ArrayVar e _) = e
-        hasExp (ImpGen.ScalarVar e _) = e
-        hasExp (ImpGen.MemVar e _) = e
-
--- | Change every memory block to be in the global address space,
--- except those who are in the local memory space.  This only affects
--- generated code - we still need to make sure that the memory is
--- actually present on the device (and declared as variables in the
--- kernel).
-makeAllMemoryGlobal :: CallKernelGen a
-                    -> CallKernelGen a
-makeAllMemoryGlobal =
-  local $ \env -> env { ImpGen.envVtable = M.map globalMemory $ ImpGen.envVtable env
-                      , ImpGen.envDefaultSpace = Imp.Space "global"
-                      }
-  where globalMemory (ImpGen.MemVar _ entry)
-          | ImpGen.entryMemSpace entry /= Space "local" =
-              ImpGen.MemVar Nothing entry { ImpGen.entryMemSpace = Imp.Space "global" }
-        globalMemory entry =
-          entry
-
-computeMapKernelGroups :: Imp.Exp -> CallKernelGen (VName, VName)
-computeMapKernelGroups kernel_size = do
-  group_size <- newVName "group_size"
-  num_groups <- newVName "num_groups"
-  let group_size_var = Imp.var group_size int32
-  ImpGen.emit $ Imp.DeclareScalar group_size int32
-  ImpGen.emit $ Imp.DeclareScalar num_groups int32
-  ImpGen.emit $ Imp.Op $ Imp.GetSize group_size group_size Imp.SizeGroup
-  ImpGen.emit $ Imp.SetScalar num_groups $
-    kernel_size `quotRoundingUp` Imp.ConvOpExp (SExt Int32 Int32) group_size_var
-  return (group_size, num_groups)
-
-isMapTransposeKernel :: PrimType -> ImpGen.MemLocation -> ImpGen.MemLocation
-                     -> Maybe (Imp.Exp, Imp.Exp,
-                               Imp.Exp, Imp.Exp, Imp.Exp,
-                               Imp.Exp, Imp.Exp)
-isMapTransposeKernel bt
-  (ImpGen.MemLocation _ _ destIxFun)
-  (ImpGen.MemLocation _ _ srcIxFun)
-  | Just (dest_offset, perm_and_destshape) <- IxFun.rearrangeWithOffset destIxFun bt_size,
-    (perm, destshape) <- unzip perm_and_destshape,
-    srcshape' <- IxFun.shape srcIxFun,
-    Just src_offset <- IxFun.linearWithOffset srcIxFun bt_size,
-    Just (r1, r2, _) <- isMapTranspose perm =
-    isOk (product srcshape') (product destshape) destshape swap r1 r2 dest_offset src_offset
-  | Just dest_offset <- IxFun.linearWithOffset destIxFun bt_size,
-    Just (src_offset, perm_and_srcshape) <- IxFun.rearrangeWithOffset srcIxFun bt_size,
-    (perm, srcshape) <- unzip perm_and_srcshape,
-    destshape' <- IxFun.shape destIxFun,
-    Just (r1, r2, _) <- isMapTranspose perm =
-    isOk (product srcshape) (product destshape') srcshape id r1 r2 dest_offset src_offset
-  | otherwise =
-    Nothing
-  where bt_size = primByteSize bt
-        swap (x,y) = (y,x)
-
-        isOk src_elems dest_elems shape f r1 r2 dest_offset src_offset = do
-          let (num_arrays, size_x, size_y) = getSizes shape f r1 r2
-          return (dest_offset, src_offset,
-                  num_arrays, size_x, size_y,
-                  src_elems, dest_elems)
-
-        getSizes shape f r1 r2 =
-          let (mapped, notmapped) = splitAt r1 shape
-              (pretrans, posttrans) = f $ splitAt r2 notmapped
-          in (product mapped, product pretrans, product posttrans)
-
-writeParamToLocalMemory :: Typed (MemBound u) =>
-                           Imp.Exp -> (VName, t) -> Param (MemBound u)
-                        -> ImpGen.ImpM lore op ()
-writeParamToLocalMemory i (mem, _) param
-  | Prim t <- paramType param =
-      ImpGen.emit $
-      Imp.Write mem (bytes i') bt (Space "local") Imp.Volatile $
-      Imp.var (paramName param) t
-  | otherwise =
-      return ()
-  where i' = i * Imp.LeafExp (Imp.SizeOf bt) int32
-        bt = elemType $ paramType param
-
-readParamFromLocalMemory :: Typed (MemBound u) =>
-                            VName -> Imp.Exp -> Param (MemBound u) -> (VName, t)
-                         -> ImpGen.ImpM lore op ()
-readParamFromLocalMemory index i param (l_mem, _)
-  | Prim _ <- paramType param =
-      ImpGen.emit $
-      Imp.SetScalar (paramName param) $
-      Imp.index l_mem (bytes i') bt (Space "local") Imp.Volatile
-  | otherwise =
-      ImpGen.emit $
-      Imp.SetScalar index i
-  where i' = i * Imp.LeafExp (Imp.SizeOf bt) int32
-        bt = elemType $ paramType param
-
-computeThreadChunkSize :: SplitOrdering
-                       -> Imp.Exp
-                       -> Imp.Count Imp.Elements
-                       -> Imp.Count Imp.Elements
-                       -> VName
-                       -> ImpGen.ImpM lore op ()
-computeThreadChunkSize (SplitStrided stride) thread_index elements_per_thread num_elements chunk_var = do
-  stride' <- ImpGen.compileSubExp stride
-  ImpGen.emit $ Imp.SetScalar chunk_var $ Imp.BinOpExp (SMin Int32)
-    (Imp.innerExp elements_per_thread) $
-    (Imp.innerExp num_elements - thread_index)
-    `quotRoundingUp`
-    stride'
-
-computeThreadChunkSize SplitContiguous thread_index elements_per_thread num_elements chunk_var = do
-  starting_point <- newVName "starting_point"
-  remaining_elements <- newVName "remaining_elements"
-
-  ImpGen.emit $
-    Imp.DeclareScalar starting_point int32
-  ImpGen.emit $
-    Imp.SetScalar starting_point $
-    thread_index * Imp.innerExp elements_per_thread
-
-  ImpGen.emit $
-    Imp.DeclareScalar remaining_elements int32
-  ImpGen.emit $
-    Imp.SetScalar remaining_elements $
-    Imp.innerExp num_elements - Imp.var starting_point int32
-
-  let no_remaining_elements = Imp.CmpOpExp (CmpSle Int32)
-                              (Imp.var remaining_elements int32) 0
-      beyond_bounds = Imp.CmpOpExp (CmpSle Int32)
-                      (Imp.innerExp num_elements)
-                      (Imp.var starting_point int32)
-
-  ImpGen.emit $
-    Imp.If (Imp.BinOpExp LogOr no_remaining_elements beyond_bounds)
-    (Imp.SetScalar chunk_var 0)
-    (Imp.If is_last_thread
-     (Imp.SetScalar chunk_var $ Imp.innerExp last_thread_elements)
-     (Imp.SetScalar chunk_var $ Imp.innerExp elements_per_thread))
-  where last_thread_elements =
-          num_elements - Imp.elements thread_index * elements_per_thread
-        is_last_thread =
-          Imp.CmpOpExp (CmpSlt Int32)
-          (Imp.innerExp num_elements)
-          ((thread_index + 1) * Imp.innerExp elements_per_thread)
-
-inBlockScan :: Imp.Exp
-           -> Imp.Exp
-           -> Imp.Exp
-           -> VName
-           -> [(VName, t)]
-           -> Lambda InKernel
-           -> InKernelGen ()
-inBlockScan lockstep_width block_size active local_id acc_local_mem scan_lam = ImpGen.everythingVolatile $ do
-  skip_threads <- newVName "skip_threads"
-  let in_block_thread_active =
-        Imp.CmpOpExp (CmpSle Int32) (Imp.var skip_threads int32) in_block_id
-      (scan_lam_i, other_index_param, actual_params) =
-        partitionChunkedKernelLambdaParameters $ lambdaParams scan_lam
-      (x_params, y_params) =
-        splitAt (length actual_params `div` 2) actual_params
-  read_operands <-
-    ImpGen.collect $
-    zipWithM_ (readParamFromLocalMemory (paramName other_index_param) $
-               Imp.var local_id int32 - Imp.var skip_threads int32)
-    x_params acc_local_mem
-  scan_y_dest <- ImpGen.destinationFromParams y_params
-
-  -- Set initial y values
-  read_my_initial <- ImpGen.collect $
-                     zipWithM_ (readParamFromLocalMemory scan_lam_i $ Imp.var local_id int32)
-                     y_params acc_local_mem
-  ImpGen.emit $ Imp.If active read_my_initial mempty
-
-  op_to_y <- ImpGen.collect $ ImpGen.compileBody scan_y_dest $ lambdaBody scan_lam
-  write_operation_result <-
-    ImpGen.collect $
-    zipWithM_ (writeParamToLocalMemory $ Imp.var local_id int32)
-    acc_local_mem y_params
-  let andBlockActive = Imp.BinOpExp LogAnd active
-      maybeBarrier = Imp.If (Imp.CmpOpExp (CmpSle Int32) lockstep_width (Imp.var skip_threads int32))
-                     (Imp.Op Imp.Barrier) mempty
-
-  ImpGen.emit $
-    Imp.Comment "in-block scan (hopefully no barriers needed)" $
-    Imp.DeclareScalar skip_threads int32 <>
-    Imp.SetScalar skip_threads 1 <>
-    Imp.While (Imp.CmpOpExp (CmpSlt Int32) (Imp.var skip_threads int32) block_size)
-    (Imp.If (andBlockActive in_block_thread_active)
-      (Imp.Comment "read operands" read_operands <>
-       Imp.Comment "perform operation" op_to_y) mempty <>
-
-     maybeBarrier <>
-
-     Imp.If (andBlockActive in_block_thread_active)
-      (Imp.Comment "write result" write_operation_result) mempty <>
-     maybeBarrier <>
-     Imp.SetScalar skip_threads (Imp.var skip_threads int32 * 2))
-  where block_id = Imp.BinOpExp (SQuot Int32) (Imp.var local_id int32) block_size
-        in_block_id = Imp.var local_id int32 - block_id * block_size
-
-data KernelConstants = KernelConstants
-                       { kernelGlobalThreadId :: VName
-                       , kernelLocalThreadId :: VName
-                       , kernelGroupId :: VName
-                       , kernelGroupSize :: Imp.DimSize
-                       , _kernelNumThreads :: Imp.DimSize
-                       , kernelWaveSize :: Imp.DimSize
-                       , kernelDimensions :: [(VName, Imp.Exp)]
-                       , kernelThreadActive :: Imp.Exp
-                       , kernelStreamed :: [(VName, Imp.DimSize)]
-                       -- ^ Chunk sizez and their maximum size.  Hint
-                       -- for unrolling.
-                       }
-
--- FIXME: wing a KernelConstants structure for use in Replicate
--- compilation.  This cannot be the best way to do this...
-simpleKernelConstants :: MonadFreshNames m =>
-                         Maybe Int -> String
-                      -> m KernelConstants
-simpleKernelConstants tag desc = do
-  thread_gtid <- maybe (newVName $ desc ++ "_gtid")
-                       (return . VName (nameFromString $ desc ++ "_gtid")) tag
-  thread_ltid <- newVName $ desc ++ "_ltid"
-  thread_gid <- newVName $ desc ++ "_gid"
-  return $ KernelConstants
-    thread_gtid thread_ltid thread_gid
-    (Imp.ConstSize 0) (Imp.ConstSize 0) (Imp.ConstSize 0)
-    [] (Imp.ValueExp $ BoolValue True) mempty
-
-compileKernelBody :: ImpGen.Destination
-                  -> KernelConstants
-                  -> KernelBody InKernel
-                  -> InKernelGen ()
-compileKernelBody (ImpGen.Destination _ dest) constants kbody =
-  compileKernelStms constants (stmsToList $ kernelBodyStms kbody) $
-  zipWithM_ (compileKernelResult constants) dest $
-  kernelBodyResult kbody
-
-compileNestedKernelBody :: KernelConstants
-                        -> ImpGen.Destination
-                        -> Body InKernel
-                        -> InKernelGen ()
-compileNestedKernelBody constants (ImpGen.Destination _ dest) kbody =
-  compileKernelStms constants (stmsToList $ bodyStms kbody) $
-  zipWithM_ ImpGen.compileSubExpTo dest $ bodyResult kbody
-
-compileKernelStms :: KernelConstants -> [Stm InKernel]
-                  -> InKernelGen a
-                  -> InKernelGen a
-compileKernelStms constants ungrouped_bnds m =
-  compileGroupedKernelStms' $ groupStmsByGuard constants ungrouped_bnds
-  where compileGroupedKernelStms' [] = m
-        compileGroupedKernelStms' ((g, bnds):rest_bnds) =
-          ImpGen.declaringScopes
-          (map ((Just . stmExp) &&& (castScope . scopeOf)) bnds) $ do
-            protect g $ mapM_ compileKernelStm bnds
-            compileGroupedKernelStms' rest_bnds
-
-        protect Nothing body_m =
-          body_m
-        protect (Just (Imp.ValueExp (BoolValue True))) body_m =
-          body_m
-        protect (Just g) body_m = do
-          body <- allThreads constants body_m
-          ImpGen.emit $ Imp.If g body mempty
-
-        compileKernelStm (Let pat _ e) = do
-          dest <- ImpGen.destinationFromPattern pat
-          ImpGen.compileExp dest e
-
-groupStmsByGuard :: KernelConstants
-                     -> [Stm InKernel]
-                     -> [(Maybe Imp.Exp, [Stm InKernel])]
-groupStmsByGuard constants bnds =
-  map collapse $ groupBy sameGuard $ zip (map bindingGuard bnds) bnds
-  where bindingGuard (Let _ _ Op{}) = Nothing
-        bindingGuard _ = Just $ kernelThreadActive constants
-
-        sameGuard (g1, _) (g2, _) = g1 == g2
-
-        collapse [] =
-          (Nothing, [])
-        collapse l@((g,_):_) =
-          (g, map snd l)
-
-compileKernelExp :: KernelConstants -> ImpGen.Destination -> KernelExp InKernel
-                 -> InKernelGen ()
-
-compileKernelExp _ (ImpGen.Destination _ dests) (Barrier ses) = do
-  zipWithM_ ImpGen.compileSubExpTo dests ses
-  ImpGen.emit $ Imp.Op Imp.Barrier
-
-compileKernelExp _ dest (SplitSpace o w i elems_per_thread)
-  | ImpGen.Destination _ [ImpGen.ScalarDestination size] <- dest = do
-      num_elements <- Imp.elements <$> ImpGen.compileSubExp w
-      i' <- ImpGen.compileSubExp i
-      elems_per_thread' <- Imp.elements <$> ImpGen.compileSubExp elems_per_thread
-      computeThreadChunkSize o i' elems_per_thread' num_elements size
-
-compileKernelExp constants dest (Combine (CombineSpace scatter cspace) ts aspace body) = do
-  -- First we compute how many times we have to iterate to cover
-  -- cspace with our group size.  It is a fairly common case that
-  -- we statically know that this requires 1 iteration, so we
-  -- could detect it and not generate a loop in that case.
-  -- However, it seems to have no impact on performance (an extra
-  -- conditional jump), so for simplicity we just always generate
-  -- the loop.
-  let cspace_dims = map (streamBounded . snd) cspace
-      num_iters = product cspace_dims `quotRoundingUp`
-                  Imp.sizeToExp (kernelGroupSize constants)
-
-  iter <- newVName "comb_iter"
-  cid <- newVName "flat_comb_id"
-
-  one_iteration <- ImpGen.collect $
-    ImpGen.declaringPrimVars (zip (map fst cspace) $ repeat int32) $
-    ImpGen.declaringPrimVar cid int32 $ do
-
-      -- Compute the *flat* array index.
-      ImpGen.emit $ Imp.SetScalar cid $
-        Imp.var iter int32 * Imp.sizeToExp (kernelGroupSize constants) +
-        Imp.var (kernelLocalThreadId constants) int32
-
-      -- Turn it into a nested array index.
-      forM_ (zip (map fst cspace) $ unflattenIndex cspace_dims (Imp.var cid int32)) $ \(v, x) ->
-        ImpGen.emit $ Imp.SetScalar v x
-
-      -- Construct the body.  This is mostly about the book-keeping
-      -- for the scatter-like part.
-      let (scatter_ws, scatter_ns, _scatter_vs) = unzip3 scatter
-          scatter_ws_repl = concat $ zipWith replicate scatter_ns scatter_ws
-          (scatter_dests, normal_dests) =
-            splitAt (sum scatter_ns) $ ImpGen.valueDestinations dest
-          (res_is, res_vs, res_normal) =
-            splitAt3 (sum scatter_ns) (sum scatter_ns) $ bodyResult body
-          scatter_is = map (pure . DimFix . ImpGen.compileSubExpOfType int32) res_is
-          scatter_dests_repl = concat $ zipWith replicate scatter_ns scatter_dests
-      (scatter_dests', normal_dests') <-
-        case (sequence $ zipWith3 index scatter_is ts scatter_dests_repl,
-              zipWithM (index local_index) (drop (sum scatter_ns*2) ts) normal_dests) of
-          (Just x, Just y) -> return (x, y)
-          _ -> fail "compileKernelExp combine: invalid destination."
-      body' <- allThreads constants $
-        ImpGen.compileStms (freeIn $ bodyResult body) (stmsToList $ bodyStms body) $ do
-
-        forM_ (zip4 scatter_ws_repl res_is res_vs scatter_dests') $
-          \(w, res_i, res_v, scatter_dest) -> do
-            let res_i' = ImpGen.compileSubExpOfType int32 res_i
-                w'     = ImpGen.compileSubExpOfType int32 w
-                -- We have to check that 'res_i' is in-bounds wrt. an array of size 'w'.
-                in_bounds = BinOpExp LogAnd (CmpOpExp (CmpSle Int32) 0 res_i')
-                                            (CmpOpExp (CmpSlt Int32) res_i' w')
-            when_in_bounds <- ImpGen.collect $ ImpGen.compileSubExpTo scatter_dest res_v
-            ImpGen.emit $ Imp.If in_bounds when_in_bounds mempty
-
-        zipWithM_ ImpGen.compileSubExpTo normal_dests' res_normal
-
-      -- Execute the body if we are within bounds.
-      ImpGen.emit $
-        Imp.If (Imp.BinOpExp LogAnd (isActive cspace) (isActive aspace)) body' mempty
-
-  ImpGen.emit $ Imp.For iter Int32 num_iters one_iteration
-  ImpGen.emit $ Imp.Op Imp.Barrier
-
-    where streamBounded (Var v)
-            | Just x <- lookup v $ kernelStreamed constants =
-                Imp.sizeToExp x
-          streamBounded se = ImpGen.compileSubExpOfType int32 se
-
-          local_index = map (DimFix . ImpGen.varIndex . fst) cspace
-
-          index i t (ImpGen.ArrayDestination (Just loc)) =
-            let space_dims = map (ImpGen.varIndex . fst) cspace
-                t_dims = map (ImpGen.compileSubExpOfType int32) $ arrayDims t
-            in Just $ ImpGen.ArrayDestination $
-               Just $ ImpGen.sliceArray loc $
-               fullSliceNum (space_dims++t_dims) i
-          index _ _ _ = Nothing
-
-compileKernelExp constants (ImpGen.Destination _ dests) (GroupReduce w lam input) = do
-  skip_waves <- newVName "skip_waves"
-  w' <- ImpGen.compileSubExp w
-
-  let local_tid = kernelLocalThreadId constants
-      (_nes, arrs) = unzip input
-      (reduce_i, reduce_j_param, actual_reduce_params) =
-        partitionChunkedKernelLambdaParameters $ lambdaParams lam
-      (reduce_acc_params, reduce_arr_params) =
-        splitAt (length input) actual_reduce_params
-      reduce_j = paramName reduce_j_param
-
-  offset <- newVName "offset"
-  ImpGen.emit $ Imp.DeclareScalar offset int32
-
-  ImpGen.Destination _ reduce_acc_targets <-
-    ImpGen.destinationFromParams reduce_acc_params
-
-  ImpGen.declaringPrimVar skip_waves int32 $
-    ImpGen.declaringLParams (lambdaParams lam) $ do
-
-    ImpGen.emit $ Imp.SetScalar reduce_i $ Imp.var local_tid int32
-
-    let setOffset x =
-          Imp.SetScalar offset x <>
-          Imp.SetScalar reduce_j (Imp.var local_tid int32 + Imp.var offset int32)
-    ImpGen.emit $ setOffset 0
-
-    set_init_params <- ImpGen.collect $
-      zipWithM_ (readReduceArgument offset) reduce_acc_params arrs
-    ImpGen.emit $
-      Imp.If (Imp.CmpOpExp (CmpSlt Int32) (Imp.var local_tid int32) w')
-      set_init_params mempty
-
-    let read_reduce_args = zipWithM_ (readReduceArgument offset)
-                           reduce_arr_params arrs
-        reduce_acc_dest = ImpGen.Destination Nothing reduce_acc_targets
-        do_reduce = do ImpGen.comment "read array element" read_reduce_args
-                       ImpGen.compileBody reduce_acc_dest $ lambdaBody lam
-                       zipWithM_ (writeReduceOpResult local_tid)
-                         reduce_acc_params arrs
-
-    in_wave_reduce <- ImpGen.collect $ ImpGen.everythingVolatile do_reduce
-    cross_wave_reduce <- ImpGen.collect do_reduce
-
-    let wave_size = Imp.sizeToExp $ kernelWaveSize constants
-        group_size = Imp.sizeToExp $ kernelGroupSize constants
-        wave_id = Imp.var local_tid int32 `quot` wave_size
-        in_wave_id = Imp.var local_tid int32 - wave_id * wave_size
-        num_waves = (group_size + wave_size - 1) `quot` wave_size
-        arg_in_bounds = Imp.CmpOpExp (CmpSlt Int32)
-                        (Imp.var reduce_j int32) w'
-
-        doing_in_wave_reductions =
-          Imp.CmpOpExp (CmpSlt Int32) (Imp.var offset int32) wave_size
-        apply_in_in_wave_iteration =
-          Imp.CmpOpExp (CmpEq int32)
-          (Imp.BinOpExp (And Int32) in_wave_id (2 * Imp.var offset int32 - 1)) 0
-        in_wave_reductions =
-          setOffset 1 <>
-          Imp.While doing_in_wave_reductions
-            (Imp.If (Imp.BinOpExp LogAnd arg_in_bounds apply_in_in_wave_iteration)
-             in_wave_reduce mempty <>
-             setOffset (Imp.var offset int32 * 2))
-
-        doing_cross_wave_reductions =
-          Imp.CmpOpExp (CmpSlt Int32) (Imp.var skip_waves int32) num_waves
-        is_first_thread_in_wave =
-          Imp.CmpOpExp (CmpEq int32) in_wave_id 0
-        wave_not_skipped =
-          Imp.CmpOpExp (CmpEq int32)
-          (Imp.BinOpExp (And Int32) wave_id (2 * Imp.var skip_waves int32 - 1))
-          0
-        apply_in_cross_wave_iteration =
-          Imp.BinOpExp LogAnd arg_in_bounds $
-          Imp.BinOpExp LogAnd is_first_thread_in_wave wave_not_skipped
-        cross_wave_reductions =
-          Imp.SetScalar skip_waves 1 <>
-          Imp.While doing_cross_wave_reductions
-            (Imp.Op Imp.Barrier <>
-             setOffset (Imp.var skip_waves int32 * wave_size) <>
-             Imp.If apply_in_cross_wave_iteration
-             cross_wave_reduce mempty <>
-             Imp.SetScalar skip_waves (Imp.var skip_waves int32 * 2))
-
-    ImpGen.emit $
-      in_wave_reductions <> cross_wave_reductions
-
-    forM_ (zip dests reduce_acc_params) $ \(dest, reduce_acc_param) ->
-      ImpGen.copyDWIMDest dest [] (Var $ paramName reduce_acc_param) []
-  where readReduceArgument offset param arr
-          | Prim _ <- paramType param =
-              ImpGen.copyDWIM (paramName param) [] (Var arr) [i]
-          | otherwise =
-              return ()
-          where i = ImpGen.varIndex (kernelLocalThreadId constants) + ImpGen.varIndex offset
-
-        writeReduceOpResult i param arr
-          | Prim _ <- paramType param =
-              ImpGen.copyDWIM arr [ImpGen.varIndex i] (Var $ paramName param) []
-          | otherwise =
-              return ()
-
-compileKernelExp constants _ (GroupScan w lam input) = do
-  renamed_lam <- renameLambda lam
-  w' <- ImpGen.compileSubExp w
-
-  when (any (not . primType . paramType) $ lambdaParams lam) $
-    compilerLimitationS "Cannot compile parallel scans with array element type."
-
-  let local_tid = kernelLocalThreadId constants
-      (_nes, arrs) = unzip input
-      (lam_i, other_index_param, actual_params) =
-        partitionChunkedKernelLambdaParameters $ lambdaParams lam
-      (x_params, y_params) =
-        splitAt (length input) actual_params
-
-  ImpGen.declaringLParams (lambdaParams lam++lambdaParams renamed_lam) $ do
-    ImpGen.emit $ Imp.SetScalar lam_i $ Imp.var local_tid int32
-
-    acc_local_mem <- flip zip (repeat ()) <$>
-                     mapM (fmap (ImpGen.memLocationName . ImpGen.entryArrayLocation) .
-                           ImpGen.lookupArray) arrs
-
-    -- The scan works by splitting the group into blocks, which are
-    -- scanned separately.  Typically, these blocks are smaller than
-    -- the lockstep width, which enables barrier-free execution inside
-    -- them.
-    --
-    -- We hardcode the block size here.  The only requirement is that
-    -- it should not be less than the square root of the group size.
-    -- With 32, we will work on groups of size 1024 or smaller, which
-    -- fits every device Troels has seen.  Still, it would be nicer if
-    -- it were a runtime parameter.  Some day.
-    let block_size = Imp.ValueExp $ IntValue $ Int32Value 32
-        simd_width = Imp.sizeToExp $ kernelWaveSize constants
-        block_id = Imp.var local_tid int32 `quot` block_size
-        in_block_id = Imp.var local_tid int32 - block_id * block_size
-        doInBlockScan active = inBlockScan simd_width block_size active local_tid acc_local_mem
-        lid_in_bounds = Imp.CmpOpExp (CmpSlt Int32) (Imp.var local_tid int32) w'
-
-    doInBlockScan lid_in_bounds lam
-    ImpGen.emit $ Imp.Op Imp.Barrier
-
-    pack_block_results <-
-      ImpGen.collect $
-      zipWithM_ (writeParamToLocalMemory block_id) acc_local_mem y_params
-
-    let last_in_block =
-          Imp.CmpOpExp (CmpEq int32) in_block_id $ block_size - 1
-    ImpGen.comment
-      "last thread of block 'i' writes its result to offset 'i'" $
-      ImpGen.emit $ Imp.If (Imp.BinOpExp LogAnd last_in_block lid_in_bounds) pack_block_results mempty
-
-    ImpGen.emit $ Imp.Op Imp.Barrier
-
-    let is_first_block = Imp.CmpOpExp (CmpEq int32) block_id 0
-    ImpGen.comment
-      "scan the first block, after which offset 'i' contains carry-in for warp 'i+1'" $
-      doInBlockScan (Imp.BinOpExp LogAnd is_first_block lid_in_bounds) renamed_lam
-
-    ImpGen.emit $ Imp.Op Imp.Barrier
-
-    read_carry_in <-
-      ImpGen.collect $
-      zipWithM_ (readParamFromLocalMemory
-                 (paramName other_index_param) (block_id - 1))
-      x_params acc_local_mem
-
-    y_dest <- ImpGen.destinationFromParams y_params
-    op_to_y <- ImpGen.collect $ ImpGen.compileBody y_dest $ lambdaBody lam
-    write_final_result <- ImpGen.collect $
-      zipWithM_ (writeParamToLocalMemory $ Imp.var local_tid int32) acc_local_mem y_params
-
-    ImpGen.comment "carry-in for every block except the first" $
-      ImpGen.emit $ Imp.If (Imp.BinOpExp LogOr
-                             is_first_block
-                             (Imp.UnOpExp Not lid_in_bounds)) mempty $
-      Imp.Comment "read operands" read_carry_in <>
-      Imp.Comment "perform operation" op_to_y <>
-      Imp.Comment "write final result" write_final_result
-
-    ImpGen.emit $ Imp.Op Imp.Barrier
-
-    ImpGen.comment "restore correct values for first block" $
-      ImpGen.emit $ Imp.If is_first_block write_final_result mempty
-
-
-compileKernelExp constants (ImpGen.Destination _ final_targets) (GroupStream w maxchunk lam accs _arrs) = do
-  let GroupStreamLambda block_size block_offset acc_params arr_params body = lam
-      block_offset' = Imp.var block_offset int32
-  w' <- ImpGen.compileSubExp w
-  max_block_size <- ImpGen.compileSubExp maxchunk
-  acc_dest <- ImpGen.destinationFromParams acc_params
-
-  ImpGen.declaringLParams (acc_params++arr_params) $ do
-    zipWithM_ ImpGen.compileSubExpTo (ImpGen.valueDestinations acc_dest) accs
-    ImpGen.declaringPrimVar block_size int32 $
-      -- If the GroupStream is morally just a do-loop, generate simpler code.
-      case mapM isSimpleThreadInSpace $ stmsToList $ bodyStms body of
-        Just stms' | ValueExp x <- max_block_size, oneIsh x -> do
-          let body' = body { bodyStms = stmsFromList stms' }
-          body'' <- ImpGen.withPrimVar block_offset int32 $
-                    allThreads constants $ ImpGen.emit =<<
-                    ImpGen.compileLoopBody (map paramName acc_params) body'
-          ImpGen.emit $ Imp.SetScalar block_size 1
-
-          -- Check if loop is candidate for unrolling.
-          let loop =
-                case w of
-                  Var w_var | Just w_bound <- lookup w_var $ kernelStreamed constants,
-                              w_bound /= Imp.ConstSize 1 ->
-                              -- Candidate for unrolling, so generate two loops.
-                              Imp.If (CmpOpExp (CmpEq int32) w' (Imp.sizeToExp w_bound))
-                              (Imp.For block_offset Int32 (Imp.sizeToExp w_bound) body'')
-                              (Imp.For block_offset Int32 w' body'')
-                  _ -> Imp.For block_offset Int32 w' body''
-
-          ImpGen.emit $
-            if kernelThreadActive constants == Imp.ValueExp (BoolValue True)
-            then loop
-            else Imp.If (kernelThreadActive constants) loop mempty
-
-        _ -> ImpGen.declaringPrimVar block_offset int32 $ do
-          body' <- streaming constants block_size maxchunk $
-                   ImpGen.compileBody acc_dest body
-
-          ImpGen.emit $ Imp.SetScalar block_offset 0
-
-          let not_at_end =
-                Imp.CmpOpExp (CmpSlt Int32) block_offset' w'
-              set_block_size =
-                Imp.If (Imp.CmpOpExp (CmpSlt Int32)
-                         (w' - block_offset')
-                         max_block_size)
-                (Imp.SetScalar block_size (w' - block_offset'))
-                (Imp.SetScalar block_size max_block_size)
-              increase_offset =
-                Imp.SetScalar block_offset $
-                block_offset' + max_block_size
-
-          -- Three cases to consider for simpler generated code based
-          -- on max block size: (0) if full input size, do not
-          -- generate a loop; (1) if one, generate for-loop (2)
-          -- otherwise, generate chunked while-loop.
-          ImpGen.emit $
-            if max_block_size == w' then
-              Imp.SetScalar block_size w' <> body'
-            else if max_block_size == Imp.ValueExp (value (1::Int32)) then
-                   Imp.SetScalar block_size w' <>
-                   Imp.For block_offset Int32 w' body'
-                 else
-                   Imp.While not_at_end $
-                   set_block_size <> body' <> increase_offset
-
-    zipWithM_ ImpGen.compileSubExpTo final_targets $
-      map (Var . paramName) acc_params
-
-      where isSimpleThreadInSpace (Let _ _ Op{}) = Nothing
-            isSimpleThreadInSpace bnd = Just bnd
-
-compileKernelExp _ _ (GroupGenReduce w [a] op bucket [v] _)
-  | [Prim t] <- lambdaReturnType op,
-    primBitSize t == 32 = do
-  -- If we have only one array and one non-array value (this is a
-  -- one-to-one correspondance) then we need only one
-  -- update. If operator has an atomic implementation we use
-  -- that, otherwise it is still a binary operator which can
-  -- be implemented by atomic compare-and-swap if 32 bits.
-
-  -- Common variables.
-  old <- newVName "old"
-  old_bits <- newVName "old_bits"
-  ImpGen.emit $ Imp.DeclareScalar old t
-  ImpGen.emit $ Imp.DeclareScalar old_bits int32
-  bucket' <- mapM ImpGen.compileSubExp bucket
-  w' <- mapM ImpGen.compileSubExp w
-
-  (arr', _a_space, bucket_offset) <- ImpGen.fullyIndexArray a bucket'
-
-  case opHasAtomicSupport old arr' bucket_offset op of
-    Just f -> do
-      val' <- ImpGen.compileSubExp v
-
-      ImpGen.emit $
-        Imp.If (indexInBounds bucket' w')
-        (Imp.Op $ f val')
-        Imp.Skip
-
-    Nothing -> do
-      -- Code generation target:
-      --
-      -- old = d_his[idx];
-      -- do {
-      --   assumed = old;
-      --   tmp = OP::apply(val, assumed);
-      --   old = atomicCAS(&d_his[idx], assumed, tmp);
-      -- } while(assumed != old);
-      assumed <- newVName "assumed"
-      run_loop <- newVName "run_loop"
-      ImpGen.emit $ Imp.DeclareScalar assumed t
-      ImpGen.emit $ Imp.DeclareScalar run_loop int32
-
-      read_old <- ImpGen.collect $
-        ImpGen.copyDWIMDest (ImpGen.ScalarDestination old) [] (Var a) bucket'
-
-      ImpGen.emit $
-        Imp.If (indexInBounds bucket' w')
-        -- True branch: bucket in-bounds -> enter loop
-        (Imp.SetScalar run_loop 1 <> read_old)
-        -- False branch: bucket out-of-bounds -> skip loop
-        (Imp.SetScalar run_loop 0)
-
-        -- Preparing parameters
-      let (acc_p:arr_p:_) = lambdaParams op
-
-      -- Store result from operator in accumulators
-      dests <- ImpGen.destinationFromParams [acc_p]
-
-      -- Critical section
-      ImpGen.declaringLParams (lambdaParams op) $ do
-        bind_acc_param <- ImpGen.collect $
-          ImpGen.copyDWIMDest (ImpGen.ScalarDestination $ paramName acc_p) [] v []
-
-        let bind_arr_param =
-              Imp.SetScalar (paramName arr_p) $ Imp.var assumed t
-
-        op_body <- ImpGen.collect $
-          ImpGen.compileBody dests $ lambdaBody op
-
-        -- While-loop: Try to insert your value
-        let (toBits, fromBits) =
-              case t of FloatType Float32 -> (\x -> Imp.FunExp "to_bits32" [x] int32,
-                                              \x -> Imp.FunExp "from_bits32" [x] t)
-                        _                 -> (id, id)
-        ImpGen.emit $ Imp.While (Imp.var run_loop int32)
-          (Imp.SetScalar assumed (Imp.var old t) <>
-           bind_acc_param <> bind_arr_param <> op_body
-           <>
-           (Imp.Op $
-               Imp.Atomic $
-                 Imp.AtomicCmpXchg old_bits arr' bucket_offset
-                   (toBits (Imp.var assumed int32)) (toBits (Imp.var (paramName acc_p) int32)))
-           <>
-           Imp.SetScalar old (fromBits (Imp.var old_bits int32))
-           <>
-            Imp.If
-              (Imp.CmpOpExp
-                (CmpEq int32) (toBits $ Imp.var assumed t) (Imp.var old_bits int32))
-              -- True branch:
-              (Imp.SetScalar run_loop 0)
-              -- False branch:
-              Imp.Skip
-          )
-
-    where opHasAtomicSupport old arr' bucket' lam = do
-            let atomic f = Imp.Atomic . f old arr' bucket'
-                atomics = [ (Add Int32, Imp.AtomicAdd)
-                          , (SMax Int32, Imp.AtomicSMax)
-                          , (SMin Int32, Imp.AtomicSMin)
-                          , (UMax Int32, Imp.AtomicUMax)
-                          , (UMin Int32, Imp.AtomicUMin)
-                          , (And Int32, Imp.AtomicAnd)
-                          , (Or Int32, Imp.AtomicOr)
-                          , (Xor Int32, Imp.AtomicXor)
-                          ]
-            [BasicOp (BinOp bop _ _)] <-
-              Just $ map stmExp $ stmsToList $ bodyStms $ lambdaBody lam
-            atomic <$> lookup bop atomics
-
-compileKernelExp _ _ (GroupGenReduce w arrs op bucket values locks) = do
-  old <- newVName "old"
-  tmp <- newVName "tmp"
-  loop_done <- newVName "loop_done"
-  ImpGen.emit $
-    Imp.DeclareScalar old int32 <>
-    Imp.DeclareScalar tmp int32 <>
-    Imp.DeclareScalar loop_done int32
-
-  -- Check if bucket is in-bounds
-  bucket' <- mapM ImpGen.compileSubExp bucket
-  w' <- mapM ImpGen.compileSubExp w
-
-  -- Correctly index into locks.
-  (locks', _locks_space, locks_offset) <-
-    ImpGen.fullyIndexArray locks bucket'
-
-  ImpGen.emit $
-    Imp.If (indexInBounds bucket' w')
-    -- True branch: bucket in-bounds -> enter loop
-    (Imp.SetScalar loop_done 0)
-    -- False branch: bucket out-of-bounds -> skip loop
-    (Imp.SetScalar loop_done 1)
-
-  -- Preparing parameters
-  let (acc_params, arr_params) =
-        splitAt (length values) $ lambdaParams op
-
-  -- Store result from operator in accumulators
-  dests <- ImpGen.destinationFromParams acc_params
-
-  -- Critical section
-  ImpGen.declaringLParams (lambdaParams op) $ do
-    let try_acquire_lock =
-          Imp.Op $ Imp.Atomic $
-          Imp.AtomicXchg old locks' locks_offset 1
-        lock_acquired =
-          Imp.CmpOpExp (CmpEq int32) (Imp.var old int32) 0
-        loop_cond =
-          Imp.CmpOpExp (CmpEq int32) (Imp.var loop_done int32) 0
-        break_loop =
-          Imp.SetScalar loop_done 1
-
-    -- We copy the current value and the new value to the parameters
-    -- unless they are array-typed.  If they are arrays, then the
-    -- index functions should already be set up correctly, so there is
-    -- nothing more to do.
-    bind_acc_params <- ImpGen.collect $
-      forM_ (zip acc_params arrs) $ \(acc_p, arr) ->
-      when (primType (paramType acc_p)) $
-      ImpGen.copyDWIMDest (ImpGen.ScalarDestination $ paramName acc_p) [] (Var arr) bucket'
-
-    bind_arr_params <- ImpGen.collect $
-      forM_ (zip arr_params values) $ \(arr_p, val) ->
-      when (primType (paramType arr_p)) $
-      ImpGen.copyDWIMDest (ImpGen.ScalarDestination $ paramName arr_p) [] val []
-
-    op_body <- ImpGen.collect $
-      ImpGen.compileBody dests $ lambdaBody op
-
-    do_gen_reduce <- ImpGen.collect $
-      zipWithM_ (writeArray bucket') arrs $ map (Var . paramName) acc_params
-
-    release_lock <- ImpGen.collect $
-      ImpGen.copyDWIM locks bucket' (intConst Int32 0) []
-
-    -- While-loop: Try to insert your value
-    ImpGen.emit $ Imp.While loop_cond
-      (try_acquire_lock <>
-        Imp.If lock_acquired
-         -- True branch
-         (bind_acc_params <> bind_arr_params <> op_body <> do_gen_reduce <> release_lock <> break_loop)
-         -- False branch
-         Imp.Skip
-         <>
-        Imp.Op Imp.MemFence
-      )
-  where writeArray i arr val =
-          ImpGen.copyDWIM arr i val []
-
-compileKernelExp _ dest e =
-  compilerBugS $ unlines ["Invalid target", "  " ++ show dest,
-                          "for kernel expression", "  " ++ pretty e]
-
--- Requires that the lists are of equal length, otherwise
--- zip with truncate the longer list.
-indexInBounds :: [Imp.Exp] -> [Imp.Exp] -> Imp.Exp
-indexInBounds inds bounds =
-  foldl1 (Imp.BinOpExp LogAnd) $ zipWith checkBound inds bounds
-  where checkBound ind bound =
-          Imp.BinOpExp LogAnd
-           (Imp.CmpOpExp (CmpSle Int32) 0 ind)
-           (Imp.CmpOpExp (CmpSlt Int32) ind bound)
-
-allThreads :: KernelConstants -> InKernelGen () -> InKernelGen Imp.KernelCode
-allThreads constants = ImpGen.subImpM_ $ inKernelOperations constants'
-  where constants' =
-          constants { kernelThreadActive = Imp.ValueExp (BoolValue True) }
-
-streaming :: KernelConstants -> VName -> SubExp -> InKernelGen () -> InKernelGen Imp.KernelCode
-streaming constants chunksize bound m = do
-  bound' <- ImpGen.subExpToDimSize bound
-  let constants' =
-        constants { kernelStreamed = (chunksize, bound') : kernelStreamed constants }
-  ImpGen.subImpM_ (inKernelOperations constants') m
-
-compileKernelResult :: KernelConstants -> ImpGen.ValueDestination -> KernelResult
-                    -> InKernelGen ()
-
-compileKernelResult constants dest (ThreadsReturn OneResultPerGroup what) = do
-  i <- newVName "i"
-
-  in_local_memory <- arrayInLocalMemory what
-  let me = Imp.var (kernelLocalThreadId constants) int32
-
-  if not in_local_memory then do
-    write_result <-
-      ImpGen.collect $
-      ImpGen.copyDWIMDest dest [ImpGen.varIndex $ kernelGroupId constants] what []
-
-    who' <- ImpGen.compileSubExp $ intConst Int32 0
-    ImpGen.emit $
-      Imp.If (Imp.CmpOpExp (CmpEq int32) me who') write_result mempty
-    else do
-      -- If the result of the group is an array in local memory, we
-      -- store it by collective copying among all the threads of the
-      -- group.  TODO: also do this if the array is in global memory
-      -- (but this is a bit more tricky, synchronisation-wise).
-      --
-      -- We do the reads/writes multidimensionally, but the loop is
-      -- single-dimensional.
-      ws <- mapM ImpGen.compileSubExp . arrayDims =<< subExpType what
-      -- Compute how many elements this thread is responsible for.
-      -- Formula: (w - ltid) / group_size (rounded up).
-      let w = product ws
-          ltid = ImpGen.varIndex (kernelLocalThreadId constants)
-          group_size = Imp.sizeToExp (kernelGroupSize constants)
-          to_write = (w - ltid) `quotRoundingUp` group_size
-          is = unflattenIndex ws $ ImpGen.varIndex i * group_size + ltid
-
-      write_result <-
-        ImpGen.collect $
-        ImpGen.copyDWIMDest dest (ImpGen.varIndex (kernelGroupId constants) : is)
-                            what is
-
-      ImpGen.emit $ Imp.For i Int32 to_write write_result
-
-compileKernelResult constants dest (ThreadsReturn AllThreads what) =
-  ImpGen.copyDWIMDest dest [ImpGen.varIndex $ kernelGlobalThreadId constants] what []
-
-compileKernelResult constants dest (ThreadsReturn (ThreadsPerGroup limit) what) = do
-  write_result <-
-    ImpGen.collect $
-    ImpGen.copyDWIMDest dest [ImpGen.varIndex $ kernelGroupId constants] what []
-
-  ImpGen.emit $ Imp.If (isActive limit) write_result mempty
-
-compileKernelResult constants dest (ThreadsReturn ThreadsInSpace what) = do
-  let is = map (ImpGen.varIndex . fst) $ kernelDimensions constants
-  write_result <- ImpGen.collect $ ImpGen.copyDWIMDest dest is what []
-  ImpGen.emit $ Imp.If (kernelThreadActive constants)
-    write_result mempty
-
-compileKernelResult constants dest (ConcatReturns SplitContiguous _ per_thread_elems moffset what) = do
-  ImpGen.ArrayDestination (Just dest_loc) <- return dest
-  let dest_loc_offset = ImpGen.offsetArray dest_loc offset
-      dest' = ImpGen.ArrayDestination $ Just dest_loc_offset
-  ImpGen.copyDWIMDest dest' [] (Var what) []
-  where offset = case moffset of
-                   Nothing -> ImpGen.compileSubExpOfType int32 per_thread_elems *
-                              ImpGen.varIndex (kernelGlobalThreadId constants)
-                   Just se -> ImpGen.compileSubExpOfType int32 se
-
-compileKernelResult constants dest (ConcatReturns (SplitStrided stride) _ _ moffset what) = do
-  ImpGen.ArrayDestination (Just dest_loc) <- return dest
-  let dest_loc' = ImpGen.strideArray
-                  (ImpGen.offsetArray dest_loc offset) $
-                  ImpGen.compileSubExpOfType int32 stride
-      dest' = ImpGen.ArrayDestination $ Just dest_loc'
-  ImpGen.copyDWIMDest dest' [] (Var what) []
-  where offset = case moffset of
-                   Nothing -> ImpGen.varIndex (kernelGlobalThreadId constants)
-                   Just se -> ImpGen.compileSubExpOfType int32 se
-
-compileKernelResult constants dest (WriteReturn rws _arr dests) = do
-  rws' <- mapM ImpGen.compileSubExp rws
-  forM_ dests $ \(is, e) -> do
-    is' <- mapM ImpGen.compileSubExp is
-    let condInBounds0 = Imp.CmpOpExp (Imp.CmpSle Int32) $
-                        Imp.ValueExp (IntValue (Int32Value 0))
-        condInBounds1 = Imp.CmpOpExp (Imp.CmpSlt Int32)
-        condInBounds i rw = Imp.BinOpExp LogAnd (condInBounds0 i) (condInBounds1 i rw)
-        write = foldl (Imp.BinOpExp LogAnd) (kernelThreadActive constants) $
-                zipWith condInBounds is' rws'
-    actual_body' <- ImpGen.collect $
-      ImpGen.copyDWIMDest dest (map (ImpGen.compileSubExpOfType int32) is) e []
-    ImpGen.emit $ Imp.If write actual_body' Imp.Skip
-
-compileKernelResult _ _ KernelInPlaceReturn{} =
-  -- Already in its place... said it was a hack.
-  return ()
-
-isActive :: [(VName, SubExp)] -> Imp.Exp
-isActive limit = case actives of
-                    [] -> Imp.ValueExp $ BoolValue True
-                    x:xs -> foldl (Imp.BinOpExp LogAnd) x xs
-  where (is, ws) = unzip limit
-        actives = zipWith active is $ map (ImpGen.compileSubExpOfType Bool) ws
-        active i = Imp.CmpOpExp (CmpSlt Int32) (Imp.var i Bool)
-
-setSpaceIndices :: KernelSpace -> InKernelGen ()
-setSpaceIndices space =
-  case spaceStructure space of
-    FlatThreadSpace is_and_dims ->
-      flatSpaceWith gtid is_and_dims
-    NestedThreadSpace is_and_dims -> do
-      let (gtids, gdims, ltids, ldims) = unzip4 is_and_dims
-      gdims' <- mapM ImpGen.compileSubExp gdims
-      ldims' <- mapM ImpGen.compileSubExp ldims
-      let (gtid_es, ltid_es) = unzip $ unflattenNestedIndex gdims' ldims' gtid
-      forM_ (zip gtids gtid_es) $ \(i,e) ->
-        ImpGen.emit $ Imp.SetScalar i e
-      forM_ (zip ltids ltid_es) $ \(i,e) ->
-        ImpGen.emit $ Imp.SetScalar i e
-  where gtid = Imp.var (spaceGlobalId space) int32
-
-        flatSpaceWith base is_and_dims = do
-          let (is, dims) = unzip is_and_dims
-          dims' <- mapM ImpGen.compileSubExp dims
-          let index_expressions = unflattenIndex dims' base
-          forM_ (zip is index_expressions) $ \(i, x) ->
-            ImpGen.emit $ Imp.SetScalar i x
+import Futhark.CodeGen.ImpGen ((<--),
+                               sFor, sWhile, sComment, sIf, sWhen, sUnless,
+                               sOp,
+                               dPrim, dPrim_, dPrimV)
+import Futhark.CodeGen.ImpGen.Kernels.Transpose
+import qualified Futhark.Representation.ExplicitMemory.IndexFunction as IxFun
+import Futhark.CodeGen.SetDefaultSpace
+import Futhark.Tools (partitionChunkedKernelLambdaParameters)
+import Futhark.Util.IntegralExp (quotRoundingUp, quot, rem, IntegralExp)
+import Futhark.Util (splitAt3)
+
+type CallKernelGen = ImpGen.ImpM ExplicitMemory Imp.HostOp
+type InKernelGen = ImpGen.ImpM InKernel Imp.KernelOp
+
+callKernelOperations :: ImpGen.Operations ExplicitMemory Imp.HostOp
+callKernelOperations =
+  ImpGen.Operations { ImpGen.opsExpCompiler = expCompiler
+                    , ImpGen.opsCopyCompiler = callKernelCopy
+                    , ImpGen.opsOpCompiler = opCompiler
+                    , ImpGen.opsStmsCompiler = ImpGen.defCompileStms
+                    }
+
+inKernelOperations :: KernelConstants -> ImpGen.Operations InKernel Imp.KernelOp
+inKernelOperations constants = (ImpGen.defaultOperations $ compileInKernelOp constants)
+                               { ImpGen.opsCopyCompiler = inKernelCopy
+                               , ImpGen.opsExpCompiler = inKernelExpCompiler
+                               , ImpGen.opsStmsCompiler = \_ -> compileKernelStms constants
+                               }
+
+compileProg :: MonadFreshNames m => Prog ExplicitMemory -> m (Either InternalError Imp.Program)
+compileProg prog =
+  fmap (setDefaultSpace (Imp.Space "device")) <$>
+  ImpGen.compileProg callKernelOperations (Imp.Space "device") prog
+
+opCompiler :: Pattern ExplicitMemory -> Op ExplicitMemory
+           -> CallKernelGen ()
+opCompiler dest (Alloc e space) =
+  ImpGen.compileAlloc dest e space
+opCompiler dest (Inner kernel) =
+  kernelCompiler dest kernel
+
+compileInKernelOp :: KernelConstants -> Pattern InKernel -> Op InKernel
+                  -> InKernelGen ()
+compileInKernelOp _ (Pattern _ [mem]) Alloc{} =
+  compilerLimitationS $ "Cannot allocate memory block " ++ pretty mem ++ " in kernel."
+compileInKernelOp _ dest Alloc{} =
+  compilerBugS $ "Invalid target for in-kernel allocation: " ++ show dest
+compileInKernelOp constants pat (Inner op) =
+  compileKernelExp constants pat op
+
+-- | Recognise kernels (maps), give everything else back.
+kernelCompiler :: Pattern ExplicitMemory -> Kernel InKernel
+               -> CallKernelGen ()
+
+kernelCompiler (Pattern _ [pe]) (GetSize key size_class) =
+  sOp $ Imp.GetSize (patElemName pe) key size_class
+
+kernelCompiler (Pattern _ [pe]) (CmpSizeLe key size_class x) =
+  sOp . Imp.CmpSizeLe (patElemName pe) key size_class =<< ImpGen.compileSubExp x
+
+kernelCompiler (Pattern _ [pe]) (GetSizeMax size_class) =
+  sOp $ Imp.GetSizeMax (patElemName pe) size_class
+
+kernelCompiler pat (Kernel desc space _ kernel_body) = do
+
+  group_size' <- ImpGen.subExpToDimSize $ spaceGroupSize space
+  num_threads' <- ImpGen.subExpToDimSize $ spaceNumThreads space
+
+  let bound_in_kernel =
+        M.keys $
+        scopeOfKernelSpace space <>
+        scopeOf (kernelBodyStms kernel_body)
+
+  let global_tid = spaceGlobalId space
+      local_tid = spaceLocalId space
+      group_id = spaceGroupId space
+  wave_size <- newVName "wave_size"
+  inner_group_size <- newVName "group_size"
+  thread_active <- newVName "thread_active"
+
+  let (space_is, space_dims) = unzip $ spaceDimensions space
+  space_dims' <- mapM ImpGen.compileSubExp space_dims
+  let constants = KernelConstants global_tid local_tid group_id
+                  group_size' num_threads'
+                  (Imp.VarSize wave_size) (zip space_is space_dims')
+                  (Imp.var thread_active Bool) mempty
+
+  kernel_body' <-
+    makeAllMemoryGlobal $ ImpGen.subImpM_ (inKernelOperations constants) $ do
+    dPrim_ wave_size int32
+    dPrim_ inner_group_size int32
+    dPrim_ thread_active Bool
+    ImpGen.dScope Nothing (scopeOfKernelSpace space)
+
+    sOp (Imp.GetGlobalId global_tid 0)
+    sOp (Imp.GetLocalId local_tid 0)
+    sOp (Imp.GetLocalSize inner_group_size 0)
+    sOp (Imp.GetLockstepWidth wave_size)
+    sOp (Imp.GetGroupId group_id 0)
+
+    setSpaceIndices space
+
+    thread_active <-- isActive (spaceDimensions space)
+
+    compileKernelBody pat constants kernel_body
+
+  (uses, local_memory) <- computeKernelUses kernel_body' bound_in_kernel
+
+  forM_ (kernelHints desc) $ \(s,v) -> do
+    ty <- case v of
+      Constant pv -> return $ Prim $ primValueType pv
+      Var vn -> lookupType vn
+    unless (primType ty) $ fail $ concat [ "debugKernelHint '", s, "'"
+                                         , " in kernel '", kernelName desc, "'"
+                                         , " did not have primType value." ]
+
+    ImpGen.compileSubExp v >>= ImpGen.emit . Imp.DebugPrint s (elemType ty)
+
+  sOp $ Imp.CallKernel $ Imp.AnyKernel Imp.Kernel
+            { Imp.kernelBody = kernel_body'
+            , Imp.kernelLocalMemory = local_memory
+            , Imp.kernelUses = uses
+            , Imp.kernelNumGroups = [ImpGen.compileSubExpOfType int32 $ spaceNumGroups space]
+            , Imp.kernelGroupSize = [ImpGen.compileSubExpOfType int32 $ spaceGroupSize space]
+            , Imp.kernelName = nameFromString $ kernelName desc ++ "_" ++
+                               show (baseTag global_tid)
+            }
+
+kernelCompiler pat e =
+  compilerBugS $ "ImpGen.kernelCompiler: Invalid pattern\n  " ++
+  pretty pat ++ "\nfor expression\n  " ++ pretty e
+
+expCompiler :: ImpGen.ExpCompiler ExplicitMemory Imp.HostOp
+-- We generate a simple kernel for itoa and replicate.
+expCompiler (Pattern _ [pe]) (BasicOp (Iota n x s et)) = do
+  destloc <- ImpGen.entryArrayLocation <$> ImpGen.lookupArray (patElemName pe)
+  let tag = Just $ baseTag $ patElemName pe
+  thread_gid <- maybe (newVName "thread_gid") (return . VName (nameFromString "thread_gid")) tag
+
+  makeAllMemoryGlobal $ do
+    (destmem, destspace, destidx) <-
+      ImpGen.fullyIndexArray' destloc [ImpGen.varIndex thread_gid] (IntType et)
+
+    n' <- ImpGen.compileSubExp n
+    x' <- ImpGen.compileSubExp x
+    s' <- ImpGen.compileSubExp s
+
+    let body = Imp.Write destmem destidx (IntType et) destspace Imp.Nonvolatile $
+               Imp.ConvOpExp (SExt Int32 et) (Imp.var thread_gid int32) * s' + x'
+
+    (group_size, num_groups) <- computeMapKernelGroups n'
+
+    (body_uses, _) <- computeKernelUses
+                      (freeIn body <> freeIn [n',x',s'])
+                      [thread_gid]
+
+    sOp $ Imp.CallKernel $ Imp.Map Imp.MapKernel
+      { Imp.mapKernelThreadNum = thread_gid
+      , Imp.mapKernelDesc = "iota"
+      , Imp.mapKernelNumGroups = Imp.VarSize num_groups
+      , Imp.mapKernelGroupSize = Imp.VarSize group_size
+      , Imp.mapKernelSize = n'
+      , Imp.mapKernelUses = body_uses
+      , Imp.mapKernelBody = body
+      }
+
+expCompiler
+  (Pattern _ [pe]) (BasicOp (Replicate (Shape ds) se)) = do
+  constants <- simpleKernelConstants (Just $ baseTag $ patElemName pe) "replicate"
+
+  t <- subExpType se
+  let thread_gid = kernelGlobalThreadId constants
+      row_dims = arrayDims t
+      dims = ds ++ row_dims
+      is' = unflattenIndex (map (ImpGen.compileSubExpOfType int32) dims) $
+            ImpGen.varIndex thread_gid
+  ds' <- mapM ImpGen.compileSubExp ds
+
+  makeAllMemoryGlobal $ do
+    body <- ImpGen.subImpM_ (inKernelOperations constants) $
+      ImpGen.copyDWIM (patElemName pe) is' se $ drop (length ds) is'
+
+    dims' <- mapM ImpGen.compileSubExp dims
+    (group_size, num_groups) <- computeMapKernelGroups $ product dims'
+
+    (body_uses, _) <- computeKernelUses
+                      (freeIn body <> freeIn ds')
+                      [thread_gid]
+
+    sOp $ Imp.CallKernel $ Imp.Map Imp.MapKernel
+      { Imp.mapKernelThreadNum = thread_gid
+      , Imp.mapKernelDesc = "replicate"
+      , Imp.mapKernelNumGroups = Imp.VarSize num_groups
+      , Imp.mapKernelGroupSize = Imp.VarSize group_size
+      , Imp.mapKernelSize = product dims'
+      , Imp.mapKernelUses = body_uses
+      , Imp.mapKernelBody = body
+      }
+
+-- Allocation in the "local" space is just a placeholder.
+expCompiler _ (Op (Alloc _ (Space "local"))) =
+  return ()
+
+expCompiler dest e =
+  ImpGen.defCompileExp dest e
+
+callKernelCopy :: ImpGen.CopyCompiler ExplicitMemory Imp.HostOp
+callKernelCopy bt
+  destloc@(ImpGen.MemLocation destmem destshape destIxFun)
+  srcloc@(ImpGen.MemLocation srcmem srcshape srcIxFun)
+  n
+  | Just (destoffset, srcoffset,
+          num_arrays, size_x, size_y,
+          src_elems, dest_elems) <- isMapTransposeKernel bt destloc srcloc = do
+
+      fname <- mapTransposeForType bt
+      ImpGen.emit $ Imp.Call [] fname
+        [Imp.MemArg destmem, Imp.ExpArg destoffset,
+         Imp.MemArg srcmem, Imp.ExpArg srcoffset,
+         Imp.ExpArg num_arrays, Imp.ExpArg size_x, Imp.ExpArg size_y,
+         Imp.ExpArg src_elems, Imp.ExpArg dest_elems]
+
+  | bt_size <- primByteSize bt,
+    ixFunMatchesInnerShape
+      (Shape $ map Imp.sizeToExp destshape) destIxFun,
+    ixFunMatchesInnerShape
+      (Shape $ map Imp.sizeToExp srcshape) srcIxFun,
+    Just destoffset <-
+      IxFun.linearWithOffset destIxFun bt_size,
+    Just srcoffset  <-
+      IxFun.linearWithOffset srcIxFun bt_size = do
+        let row_size = product $ map ImpGen.dimSizeToExp $ drop 1 srcshape
+        srcspace <- ImpGen.entryMemSpace <$> ImpGen.lookupMemory srcmem
+        destspace <- ImpGen.entryMemSpace <$> ImpGen.lookupMemory destmem
+        ImpGen.emit $ Imp.Copy
+          destmem (bytes destoffset) destspace
+          srcmem (bytes srcoffset) srcspace $
+          (n * row_size) `Imp.withElemType` bt
+
+  | otherwise = do
+  global_thread_index <- newVName "copy_global_thread_index"
+
+  -- Note that the shape of the destination and the source are
+  -- necessarily the same.
+  let shape = map Imp.sizeToExp srcshape
+      shape_se = map (Imp.innerExp . ImpGen.dimSizeToExp) srcshape
+      dest_is = unflattenIndex shape_se $ ImpGen.varIndex global_thread_index
+      src_is = dest_is
+
+  makeAllMemoryGlobal $ do
+    (_, destspace, destidx) <- ImpGen.fullyIndexArray' destloc dest_is bt
+    (_, srcspace, srcidx) <- ImpGen.fullyIndexArray' srcloc src_is bt
+
+    let body = Imp.Write destmem destidx bt destspace Imp.Nonvolatile $
+               Imp.index srcmem srcidx bt srcspace Imp.Nonvolatile
+
+    let writes_to = [Imp.MemoryUse destmem]
+
+    reads_from <- readsFromSet $
+                  S.singleton srcmem <>
+                  freeIn destIxFun <> freeIn srcIxFun <> freeIn destshape
+
+    let kernel_size = Imp.innerExp n * product (drop 1 shape)
+    (group_size, num_groups) <- computeMapKernelGroups kernel_size
+
+    let bound_in_kernel = [global_thread_index]
+    (body_uses, _) <- computeKernelUses (kernel_size, body) bound_in_kernel
+
+    sOp $ Imp.CallKernel $ Imp.Map Imp.MapKernel
+      { Imp.mapKernelThreadNum = global_thread_index
+      , Imp.mapKernelDesc = "copy"
+      , Imp.mapKernelNumGroups = Imp.VarSize num_groups
+      , Imp.mapKernelGroupSize = Imp.VarSize group_size
+      , Imp.mapKernelSize = kernel_size
+      , Imp.mapKernelUses = nub $ body_uses ++ writes_to ++ reads_from
+      , Imp.mapKernelBody = body
+      }
+
+-- | We have no bulk copy operation (e.g. memmove) inside kernels, so
+-- turn any copy into a loop.
+inKernelCopy :: ImpGen.CopyCompiler InKernel Imp.KernelOp
+inKernelCopy = ImpGen.copyElementWise
+
+mapTransposeForType :: PrimType -> ImpGen.ImpM ExplicitMemory Imp.HostOp Name
+mapTransposeForType bt = do
+  -- XXX: The leading underscore is to avoid clashes with a
+  -- programmer-defined function of the same name (this is a bad
+  -- solution...).
+  let fname = nameFromString $ "_" <> mapTransposeName bt
+
+  exists <- ImpGen.hasFunction fname
+  unless exists $ ImpGen.emitFunction fname $ mapTransposeFunction bt
+
+  return fname
+
+mapTransposeName :: PrimType -> String
+mapTransposeName bt = "map_transpose_" ++ pretty bt
+
+mapTransposeFunction :: PrimType -> Imp.Function
+mapTransposeFunction bt =
+  Imp.Function False [] params transpose_code [] []
+
+  where params = [memparam destmem, intparam destoffset,
+                  memparam srcmem, intparam srcoffset,
+                  intparam num_arrays, intparam x, intparam y,
+                  intparam in_elems, intparam out_elems]
+
+        space = Space "device"
+        memparam v = Imp.MemParam v space
+        intparam v = Imp.ScalarParam v $ IntType Int32
+
+        [destmem, destoffset, srcmem, srcoffset,
+         num_arrays, x, y, in_elems, out_elems,
+         mulx, muly, block] =
+           zipWith (VName . nameFromString)
+           ["destmem",
+             "destoffset",
+             "srcmem",
+             "srcoffset",
+             "num_arrays",
+             "x_elems",
+             "y_elems",
+             "in_elems",
+             "out_elems",
+             -- The following is only used for low width/height
+             -- transpose kernels
+             "mulx",
+             "muly",
+             "block"
+            ]
+           [0..]
+
+        v32 v = Imp.var v int32
+
+        block_dim_int = 16
+
+        block_dim :: IntegralExp a => a
+        block_dim = 16
+
+        -- When an input array has either width==1 or height==1, performing a
+        -- transpose will be the same as performing a copy.  If 'input_size' or
+        -- 'output_size' is not equal to width*height, then this trick will not
+        -- work when there are more than one array to process, as it is a per
+        -- array limit. We could copy each array individually, but currently we
+        -- do not.
+        can_use_copy =
+          let in_out_eq = CmpOpExp (CmpEq $ IntType Int32) (v32 in_elems) (v32 out_elems)
+              onearr = CmpOpExp (CmpEq $ IntType Int32) (v32 num_arrays) 1
+              noprob_widthheight = CmpOpExp (CmpEq $ IntType Int32)
+                                     (v32 x * v32 y)
+                                     (v32 in_elems)
+              height_is_one = CmpOpExp (CmpEq $ IntType Int32) (v32 y) 1
+              width_is_one = CmpOpExp (CmpEq $ IntType Int32) (v32 x) 1
+          in BinOpExp LogAnd
+               in_out_eq
+               (BinOpExp LogAnd
+                 (BinOpExp LogOr onearr noprob_widthheight)
+                 (BinOpExp LogOr width_is_one height_is_one))
+
+        transpose_code =
+          Imp.If input_is_empty mempty $ mconcat
+          [ Imp.DeclareScalar muly (IntType Int32)
+          , Imp.SetScalar muly $ block_dim `quot` v32 x
+          , Imp.DeclareScalar mulx (IntType Int32)
+          , Imp.SetScalar mulx $ block_dim `quot` v32 y
+          , Imp.If can_use_copy copy_code $
+            Imp.If should_use_lowwidth (callTransposeKernel TransposeLowWidth) $
+            Imp.If should_use_lowheight (callTransposeKernel TransposeLowHeight) $
+            Imp.If should_use_small (callTransposeKernel TransposeSmall) $
+            callTransposeKernel TransposeNormal]
+
+        input_is_empty =
+          v32 num_arrays .==. 0 .||. v32 x .==. 0 .||. v32 y .==. 0
+
+        should_use_small = BinOpExp LogAnd
+          (CmpOpExp (CmpSle Int32) (v32 x) (block_dim `quot` 2))
+          (CmpOpExp (CmpSle Int32) (v32 y) (block_dim `quot` 2))
+
+        should_use_lowwidth = BinOpExp LogAnd
+          (CmpOpExp (CmpSle Int32) (v32 x) (block_dim `quot` 2))
+          (CmpOpExp (CmpSlt Int32) block_dim (v32 y))
+
+        should_use_lowheight = BinOpExp LogAnd
+          (CmpOpExp (CmpSle Int32) (v32 y) (block_dim `quot` 2))
+          (CmpOpExp (CmpSlt Int32) block_dim (v32 x))
+
+        copy_code =
+          let num_bytes =
+                v32 in_elems * Imp.LeafExp (Imp.SizeOf bt) (IntType Int32)
+          in Imp.Copy
+               destmem (Imp.Count $ v32 destoffset) space
+               srcmem (Imp.Count $ v32 srcoffset) space
+               (Imp.Count num_bytes)
+
+        callTransposeKernel =
+          Imp.Op . Imp.CallKernel . Imp.AnyKernel .
+          mapTransposeKernel (mapTransposeName bt) block_dim_int
+          (destmem, v32 destoffset, srcmem, v32 srcoffset,
+            v32 x, v32 y, v32 in_elems, v32 out_elems,
+            v32 mulx, v32 muly, v32 num_arrays,
+            block) bt
+
+
+inKernelExpCompiler :: ImpGen.ExpCompiler InKernel Imp.KernelOp
+inKernelExpCompiler _ (BasicOp (Assert _ _ (loc, locs))) =
+  compilerLimitationS $
+  unlines [ "Cannot compile assertion at " ++
+            intercalate " -> " (reverse $ map locStr $ loc:locs) ++
+            " inside parallel kernel."
+          , "As a workaround, surround the expression with 'unsafe'."]
+-- The static arrays stuff does not work inside kernels.
+inKernelExpCompiler (Pattern _ [dest]) (BasicOp (ArrayLit es _)) =
+  forM_ (zip [0..] es) $ \(i,e) ->
+  ImpGen.copyDWIM (patElemName dest) [fromIntegral (i::Int32)] e []
+inKernelExpCompiler dest e =
+  ImpGen.defCompileExp dest e
+
+computeKernelUses :: FreeIn a =>
+                     a -> [VName]
+                  -> CallKernelGen ([Imp.KernelUse], [Imp.LocalMemoryUse])
+computeKernelUses kernel_body bound_in_kernel = do
+    let actually_free = freeIn kernel_body `S.difference` S.fromList bound_in_kernel
+
+    -- Compute the variables that we need to pass to the kernel.
+    reads_from <- readsFromSet actually_free
+
+    -- Are we using any local memory?
+    local_memory <- computeLocalMemoryUse actually_free
+    return (nub reads_from, nub local_memory)
+
+readsFromSet :: Names -> CallKernelGen [Imp.KernelUse]
+readsFromSet free =
+  fmap catMaybes $
+  forM (S.toList free) $ \var -> do
+    t <- lookupType var
+    case t of
+      Array {} -> return Nothing
+      Mem _ (Space "local") -> return Nothing
+      Mem _ _ -> return $ Just $ Imp.MemoryUse var
+      Prim bt ->
+        isConstExp var >>= \case
+          Just ce -> return $ Just $ Imp.ConstUse var ce
+          Nothing | bt == Cert -> return Nothing
+                  | otherwise  -> return $ Just $ Imp.ScalarUse var bt
+
+computeLocalMemoryUse :: Names -> CallKernelGen [Imp.LocalMemoryUse]
+computeLocalMemoryUse free =
+  fmap catMaybes $
+  forM (S.toList free) $ \var -> do
+    t <- lookupType var
+    case t of
+      Mem memsize (Space "local") -> do
+        memsize' <- localMemSize =<< ImpGen.subExpToDimSize memsize
+        return $ Just (var, memsize')
+      _ -> return Nothing
+
+localMemSize :: Imp.MemSize -> CallKernelGen (Either Imp.MemSize Imp.KernelConstExp)
+localMemSize (Imp.ConstSize x) =
+  return $ Right $ ValueExp $ IntValue $ Int64Value x
+localMemSize (Imp.VarSize v) = isConstExp v >>= \case
+  Just e | isStaticExp e -> return $ Right e
+  _ -> return $ Left $ Imp.VarSize v
+
+-- | Only some constant expressions quality as *static* expressions,
+-- which we can use for static memory allocation.  This is a bit of a
+-- hack, as it is primarly motivated by what you can put as the size
+-- when daring an array in C.
+isStaticExp :: Imp.KernelConstExp -> Bool
+isStaticExp LeafExp{} = True
+isStaticExp ValueExp{} = True
+isStaticExp (BinOpExp Add{} x y) = isStaticExp x && isStaticExp y
+isStaticExp (BinOpExp Sub{} x y) = isStaticExp x && isStaticExp y
+isStaticExp (BinOpExp Mul{} x y) = isStaticExp x && isStaticExp y
+isStaticExp _ = False
+
+isConstExp :: VName -> CallKernelGen (Maybe Imp.KernelConstExp)
+isConstExp v = do
+  vtable <- ImpGen.getVTable
+  let lookupConstExp name = constExp =<< hasExp =<< M.lookup name vtable
+      constExp (Op (Inner (GetSize key _))) = Just $ LeafExp (Imp.SizeConst key) int32
+      constExp e = primExpFromExp lookupConstExp e
+  return $ lookupConstExp v
+  where hasExp (ImpGen.ArrayVar e _) = e
+        hasExp (ImpGen.ScalarVar e _) = e
+        hasExp (ImpGen.MemVar e _) = e
+
+-- | Change every memory block to be in the global address space,
+-- except those who are in the local memory space.  This only affects
+-- generated code - we still need to make sure that the memory is
+-- actually present on the device (and dared as variables in the
+-- kernel).
+makeAllMemoryGlobal :: CallKernelGen a -> CallKernelGen a
+makeAllMemoryGlobal =
+  local (\env -> env { ImpGen.envDefaultSpace = Imp.Space "global" }) .
+  ImpGen.localVTable (M.map globalMemory)
+  where globalMemory (ImpGen.MemVar _ entry)
+          | ImpGen.entryMemSpace entry /= Space "local" =
+              ImpGen.MemVar Nothing entry { ImpGen.entryMemSpace = Imp.Space "global" }
+        globalMemory entry =
+          entry
+
+computeMapKernelGroups :: Imp.Exp -> CallKernelGen (VName, VName)
+computeMapKernelGroups kernel_size = do
+  group_size <- dPrim "group_size" int32
+  let group_size_var = Imp.var group_size int32
+  sOp $ Imp.GetSize group_size group_size Imp.SizeGroup
+  num_groups <- dPrimV "num_groups" $ kernel_size `quotRoundingUp` Imp.ConvOpExp (SExt Int32 Int32) group_size_var
+  return (group_size, num_groups)
+
+isMapTransposeKernel :: PrimType -> ImpGen.MemLocation -> ImpGen.MemLocation
+                     -> Maybe (Imp.Exp, Imp.Exp,
+                               Imp.Exp, Imp.Exp, Imp.Exp,
+                               Imp.Exp, Imp.Exp)
+isMapTransposeKernel bt
+  (ImpGen.MemLocation _ _ destIxFun)
+  (ImpGen.MemLocation _ _ srcIxFun)
+  | Just (dest_offset, perm_and_destshape) <- IxFun.rearrangeWithOffset destIxFun bt_size,
+    (perm, destshape) <- unzip perm_and_destshape,
+    srcshape' <- IxFun.shape srcIxFun,
+    Just src_offset <- IxFun.linearWithOffset srcIxFun bt_size,
+    Just (r1, r2, _) <- isMapTranspose perm =
+    isOk (product srcshape') (product destshape) destshape swap r1 r2 dest_offset src_offset
+  | Just dest_offset <- IxFun.linearWithOffset destIxFun bt_size,
+    Just (src_offset, perm_and_srcshape) <- IxFun.rearrangeWithOffset srcIxFun bt_size,
+    (perm, srcshape) <- unzip perm_and_srcshape,
+    destshape' <- IxFun.shape destIxFun,
+    Just (r1, r2, _) <- isMapTranspose perm =
+    isOk (product srcshape) (product destshape') srcshape id r1 r2 dest_offset src_offset
+  | otherwise =
+    Nothing
+  where bt_size = primByteSize bt
+        swap (x,y) = (y,x)
+
+        isOk src_elems dest_elems shape f r1 r2 dest_offset src_offset = do
+          let (num_arrays, size_x, size_y) = getSizes shape f r1 r2
+          return (dest_offset, src_offset,
+                  num_arrays, size_x, size_y,
+                  src_elems, dest_elems)
+
+        getSizes shape f r1 r2 =
+          let (mapped, notmapped) = splitAt r1 shape
+              (pretrans, posttrans) = f $ splitAt r2 notmapped
+          in (product mapped, product pretrans, product posttrans)
+
+writeParamToLocalMemory :: Typed (MemBound u) =>
+                           Imp.Exp -> (VName, t) -> Param (MemBound u)
+                        -> ImpGen.ImpM lore op ()
+writeParamToLocalMemory i (mem, _) param
+  | Prim t <- paramType param =
+      ImpGen.emit $
+      Imp.Write mem (bytes i') bt (Space "local") Imp.Volatile $
+      Imp.var (paramName param) t
+  | otherwise =
+      return ()
+  where i' = i * Imp.LeafExp (Imp.SizeOf bt) int32
+        bt = elemType $ paramType param
+
+readParamFromLocalMemory :: Typed (MemBound u) =>
+                            VName -> Imp.Exp -> Param (MemBound u) -> (VName, t)
+                         -> ImpGen.ImpM lore op ()
+readParamFromLocalMemory index i param (l_mem, _)
+  | Prim _ <- paramType param =
+      paramName param <--
+      Imp.index l_mem (bytes i') bt (Space "local") Imp.Volatile
+  | otherwise = index <-- i
+  where i' = i * Imp.LeafExp (Imp.SizeOf bt) int32
+        bt = elemType $ paramType param
+
+computeThreadChunkSize :: SplitOrdering
+                       -> Imp.Exp
+                       -> Imp.Count Imp.Elements
+                       -> Imp.Count Imp.Elements
+                       -> VName
+                       -> ImpGen.ImpM lore op ()
+computeThreadChunkSize (SplitStrided stride) thread_index elements_per_thread num_elements chunk_var = do
+  stride' <- ImpGen.compileSubExp stride
+  chunk_var <--
+    Imp.BinOpExp (SMin Int32)
+    (Imp.innerExp elements_per_thread)
+    ((Imp.innerExp num_elements - thread_index) `quotRoundingUp` stride')
+
+computeThreadChunkSize SplitContiguous thread_index elements_per_thread num_elements chunk_var = do
+  starting_point <- dPrimV "starting_point" $
+    thread_index * Imp.innerExp elements_per_thread
+  remaining_elements <- dPrimV "remaining_elements" $
+    Imp.innerExp num_elements - Imp.var starting_point int32
+
+  let no_remaining_elements = Imp.var remaining_elements int32 .<=. 0
+      beyond_bounds = Imp.innerExp num_elements .<=. Imp.var starting_point int32
+
+  sIf (no_remaining_elements .||. beyond_bounds)
+    (chunk_var <-- 0)
+    (sIf is_last_thread
+       (chunk_var <-- Imp.innerExp last_thread_elements)
+       (chunk_var <-- Imp.innerExp elements_per_thread))
+  where last_thread_elements =
+          num_elements - Imp.elements thread_index * elements_per_thread
+        is_last_thread =
+          Imp.innerExp num_elements .<.
+          (thread_index + 1) * Imp.innerExp elements_per_thread
+
+inBlockScan :: Imp.Exp
+           -> Imp.Exp
+           -> Imp.Exp
+           -> VName
+           -> [(VName, t)]
+           -> Lambda InKernel
+           -> InKernelGen ()
+inBlockScan lockstep_width block_size active local_id acc_local_mem scan_lam = ImpGen.everythingVolatile $ do
+  skip_threads <- dPrim "skip_threads" int32
+  let in_block_thread_active =
+        Imp.var skip_threads int32 .<=. in_block_id
+      (scan_lam_i, other_index_param, actual_params) =
+        partitionChunkedKernelLambdaParameters $ lambdaParams scan_lam
+      (x_params, y_params) =
+        splitAt (length actual_params `div` 2) actual_params
+      read_operands =
+        zipWithM_ (readParamFromLocalMemory (paramName other_index_param) $
+                   Imp.var local_id int32 - Imp.var skip_threads int32)
+        x_params acc_local_mem
+
+  -- Set initial y values
+  sWhen active $
+    zipWithM_ (readParamFromLocalMemory scan_lam_i $ Imp.var local_id int32)
+    y_params acc_local_mem
+
+  let op_to_y = ImpGen.compileBody' y_params $ lambdaBody scan_lam
+      write_operation_result =
+        zipWithM_ (writeParamToLocalMemory $ Imp.var local_id int32)
+        acc_local_mem y_params
+      maybeBarrier = sWhen (lockstep_width .<=. Imp.var skip_threads int32) $
+                     sOp Imp.Barrier
+
+  sComment "in-block scan (hopefully no barriers needed)" $ do
+    skip_threads <-- 1
+    sWhile (Imp.var skip_threads int32 .<. block_size) $ do
+      sWhen (in_block_thread_active .&&. active) $ do
+        sComment "read operands" read_operands
+        sComment "perform operation" op_to_y
+
+      maybeBarrier
+
+      sWhen (in_block_thread_active .&&. active) $
+        sComment "write result" write_operation_result
+
+      maybeBarrier
+
+      skip_threads <-- Imp.var skip_threads int32 * 2
+
+  where block_id = Imp.var local_id int32 `quot` block_size
+        in_block_id = Imp.var local_id int32 - block_id * block_size
+
+data KernelConstants = KernelConstants
+                       { kernelGlobalThreadId :: VName
+                       , kernelLocalThreadId :: VName
+                       , kernelGroupId :: VName
+                       , kernelGroupSize :: Imp.DimSize
+                       , _kernelNumThreads :: Imp.DimSize
+                       , kernelWaveSize :: Imp.DimSize
+                       , kernelDimensions :: [(VName, Imp.Exp)]
+                       , kernelThreadActive :: Imp.Exp
+                       , kernelStreamed :: [(VName, Imp.DimSize)]
+                       -- ^ Chunk sizez and their maximum size.  Hint
+                       -- for unrolling.
+                       }
+
+-- FIXME: wing a KernelConstants structure for use in Replicate
+-- compilation.  This cannot be the best way to do this...
+simpleKernelConstants :: MonadFreshNames m =>
+                         Maybe Int -> String
+                      -> m KernelConstants
+simpleKernelConstants tag desc = do
+  thread_gtid <- maybe (newVName $ desc ++ "_gtid")
+                       (return . VName (nameFromString $ desc ++ "_gtid")) tag
+  thread_ltid <- newVName $ desc ++ "_ltid"
+  thread_gid <- newVName $ desc ++ "_gid"
+  return $ KernelConstants
+    thread_gtid thread_ltid thread_gid
+    (Imp.ConstSize 0) (Imp.ConstSize 0) (Imp.ConstSize 0)
+    [] (Imp.ValueExp $ BoolValue True) mempty
+
+compileKernelBody :: Pattern InKernel
+                  -> KernelConstants
+                  -> KernelBody InKernel
+                  -> InKernelGen ()
+compileKernelBody pat constants kbody =
+  compileKernelStms constants (stmsToList $ kernelBodyStms kbody) $
+  zipWithM_ (compileKernelResult constants) (patternElements pat) $
+  kernelBodyResult kbody
+
+compileKernelStms :: KernelConstants -> [Stm InKernel]
+                  -> InKernelGen a
+                  -> InKernelGen a
+compileKernelStms constants ungrouped_bnds m =
+  compileGroupedKernelStms' $ groupStmsByGuard constants ungrouped_bnds
+  where compileGroupedKernelStms' [] = m
+        compileGroupedKernelStms' ((g, bnds):rest_bnds) = do
+          ImpGen.dScopes (map ((Just . stmExp) &&& (castScope . scopeOf)) bnds)
+          protect g $ mapM_ compileKernelStm bnds
+          compileGroupedKernelStms' rest_bnds
+
+        protect Nothing body_m =
+          body_m
+        protect (Just (Imp.ValueExp (BoolValue True))) body_m =
+          body_m
+        protect (Just g) body_m =
+          sWhen g $ allThreads constants body_m
+
+        compileKernelStm (Let pat _ e) = ImpGen.compileExp pat e
+
+groupStmsByGuard :: KernelConstants
+                     -> [Stm InKernel]
+                     -> [(Maybe Imp.Exp, [Stm InKernel])]
+groupStmsByGuard constants bnds =
+  map collapse $ groupBy sameGuard $ zip (map bindingGuard bnds) bnds
+  where bindingGuard (Let _ _ Op{}) = Nothing
+        bindingGuard _ = Just $ kernelThreadActive constants
+
+        sameGuard (g1, _) (g2, _) = g1 == g2
+
+        collapse [] =
+          (Nothing, [])
+        collapse l@((g,_):_) =
+          (g, map snd l)
+
+compileKernelExp :: KernelConstants -> Pattern InKernel -> KernelExp InKernel
+                 -> InKernelGen ()
+
+compileKernelExp _ pat (Barrier ses) = do
+  forM_ (zip (patternNames pat) ses) $ \(d, se) ->
+    ImpGen.copyDWIM d [] se []
+  sOp Imp.Barrier
+
+compileKernelExp _ (Pattern [] [size]) (SplitSpace o w i elems_per_thread) = do
+  num_elements <- Imp.elements <$> ImpGen.compileSubExp w
+  i' <- ImpGen.compileSubExp i
+  elems_per_thread' <- Imp.elements <$> ImpGen.compileSubExp elems_per_thread
+  computeThreadChunkSize o i' elems_per_thread' num_elements (patElemName size)
+
+compileKernelExp constants pat (Combine (CombineSpace scatter cspace) _ aspace body) = do
+  -- First we compute how many times we have to iterate to cover
+  -- cspace with our group size.  It is a fairly common case that
+  -- we statically know that this requires 1 iteration, so we
+  -- could detect it and not generate a loop in that case.
+  -- However, it seems to have no impact on performance (an extra
+  -- conditional jump), so for simplicity we just always generate
+  -- the loop.
+  let cspace_dims = map (streamBounded . snd) cspace
+      num_iters
+        | cspace_dims == [Imp.sizeToExp $ kernelGroupSize constants] = 1
+        | otherwise = product cspace_dims `quotRoundingUp`
+                      Imp.sizeToExp (kernelGroupSize constants)
+
+  iter <- newVName "comb_iter"
+
+  sFor iter Int32 num_iters $ do
+    mapM_ ((`dPrim_` int32) . fst) cspace
+    -- Compute the *flat* array index.
+    cid <- dPrimV "flat_comb_id" $
+      Imp.var iter int32 * Imp.sizeToExp (kernelGroupSize constants) +
+      Imp.var (kernelLocalThreadId constants) int32
+
+    -- Turn it into a nested array index.
+    zipWithM_ (<--) (map fst cspace) $ unflattenIndex cspace_dims (Imp.var cid int32)
+
+    -- Construct the body.  This is mostly about the book-keeping
+    -- for the scatter-like part.
+    let (scatter_ws, scatter_ns, _scatter_vs) = unzip3 scatter
+        scatter_ws_repl = concat $ zipWith replicate scatter_ns scatter_ws
+        (scatter_pes, normal_pes) =
+          splitAt (sum scatter_ns) $ patternElements pat
+        (res_is, res_vs, res_normal) =
+          splitAt3 (sum scatter_ns) (sum scatter_ns) $ bodyResult body
+
+    -- Execute the body if we are within bounds.
+    sWhen (isActive cspace .&&. isActive aspace) $ allThreads constants $
+      ImpGen.compileStms (freeIn $ bodyResult body) (stmsToList $ bodyStms body) $ do
+
+      forM_ (zip4 scatter_ws_repl res_is res_vs scatter_pes) $
+        \(w, res_i, res_v, scatter_pe) -> do
+          let res_i' = ImpGen.compileSubExpOfType int32 res_i
+              w'     = ImpGen.compileSubExpOfType int32 w
+              -- We have to check that 'res_i' is in-bounds wrt. an array of size 'w'.
+              in_bounds = 0 .<=. res_i' .&&. res_i' .<. w'
+          sWhen in_bounds $ ImpGen.copyDWIM (patElemName scatter_pe) [res_i'] res_v []
+
+      forM_ (zip normal_pes res_normal) $ \(pe, res) ->
+        ImpGen.copyDWIM (patElemName pe) local_index res []
+
+  sOp Imp.Barrier
+
+  where streamBounded (Var v)
+          | Just x <- lookup v $ kernelStreamed constants =
+              Imp.sizeToExp x
+        streamBounded se = ImpGen.compileSubExpOfType int32 se
+
+        local_index = map (ImpGen.compileSubExpOfType int32 . Var . fst) cspace
+
+compileKernelExp constants (Pattern _ dests) (GroupReduce w lam input) = do
+  groupReduce constants w lam $ map snd input
+  let (reduce_acc_params, _) =
+        splitAt (length input) $ drop 2 $ lambdaParams lam
+  forM_ (zip dests reduce_acc_params) $ \(dest, reduce_acc_param) ->
+    ImpGen.copyDWIM (patElemName dest) [] (Var $ paramName reduce_acc_param) []
+
+compileKernelExp constants _ (GroupScan w lam input) = do
+  renamed_lam <- renameLambda lam
+  w' <- ImpGen.compileSubExp w
+
+  when (any (not . primType . paramType) $ lambdaParams lam) $
+    compilerLimitationS "Cannot compile parallel scans with array element type."
+
+  let local_tid = kernelLocalThreadId constants
+      (_nes, arrs) = unzip input
+      (lam_i, other_index_param, actual_params) =
+        partitionChunkedKernelLambdaParameters $ lambdaParams lam
+      (x_params, y_params) =
+        splitAt (length input) actual_params
+
+  ImpGen.dLParams (lambdaParams lam++lambdaParams renamed_lam)
+  lam_i <-- Imp.var local_tid int32
+
+  acc_local_mem <- flip zip (repeat ()) <$>
+                   mapM (fmap (ImpGen.memLocationName . ImpGen.entryArrayLocation) .
+                         ImpGen.lookupArray) arrs
+
+  -- The scan works by splitting the group into blocks, which are
+  -- scanned separately.  Typically, these blocks are smaller than
+  -- the lockstep width, which enables barrier-free execution inside
+  -- them.
+  --
+  -- We hardcode the block size here.  The only requirement is that
+  -- it should not be less than the square root of the group size.
+  -- With 32, we will work on groups of size 1024 or smaller, which
+  -- fits every device Troels has seen.  Still, it would be nicer if
+  -- it were a runtime parameter.  Some day.
+  let block_size = Imp.ValueExp $ IntValue $ Int32Value 32
+      simd_width = Imp.sizeToExp $ kernelWaveSize constants
+      block_id = Imp.var local_tid int32 `quot` block_size
+      in_block_id = Imp.var local_tid int32 - block_id * block_size
+      doInBlockScan active = inBlockScan simd_width block_size active local_tid acc_local_mem
+      lid_in_bounds = Imp.var local_tid int32 .<. w'
+
+  doInBlockScan lid_in_bounds lam
+  sOp Imp.Barrier
+
+  let last_in_block = in_block_id .==. block_size - 1
+  sComment "last thread of block 'i' writes its result to offset 'i'" $
+    sWhen (last_in_block .&&. lid_in_bounds) $
+    zipWithM_ (writeParamToLocalMemory block_id) acc_local_mem y_params
+
+  sOp Imp.Barrier
+
+  let is_first_block = block_id .==. 0
+  ImpGen.comment
+    "scan the first block, after which offset 'i' contains carry-in for warp 'i+1'" $
+    doInBlockScan (is_first_block .&&. lid_in_bounds) renamed_lam
+
+  sOp Imp.Barrier
+
+  let read_carry_in =
+        zipWithM_ (readParamFromLocalMemory
+                   (paramName other_index_param) (block_id - 1))
+        x_params acc_local_mem
+
+  let op_to_y =
+        ImpGen.compileBody' y_params $ lambdaBody lam
+      write_final_result =
+        zipWithM_ (writeParamToLocalMemory $ Imp.var local_tid int32) acc_local_mem y_params
+
+  sComment "carry-in for every block except the first" $
+    sUnless (is_first_block .||. Imp.UnOpExp Not lid_in_bounds) $ do
+    sComment "read operands" read_carry_in
+    sComment "perform operation" op_to_y
+    sComment "write final result" write_final_result
+
+  sOp Imp.Barrier
+
+  sComment "restore correct values for first block" $
+    sWhen is_first_block write_final_result
+
+compileKernelExp constants (Pattern _ final) (GroupStream w maxchunk lam accs _arrs) = do
+  let GroupStreamLambda block_size block_offset acc_params arr_params body = lam
+      block_offset' = Imp.var block_offset int32
+  w' <- ImpGen.compileSubExp w
+  max_block_size <- ImpGen.compileSubExp maxchunk
+
+  ImpGen.dLParams (acc_params++arr_params)
+  zipWithM_ ImpGen.compileSubExpTo (map paramName acc_params) accs
+  dPrim_ block_size int32
+
+  -- If the GroupStream is morally just a do-loop, generate simpler code.
+  case mapM isSimpleThreadInSpace $ stmsToList $ bodyStms body of
+    Just stms' | ValueExp x <- max_block_size, oneIsh x -> do
+      let body' = body { bodyStms = stmsFromList stms' }
+          body'' = allThreads constants $
+                   ImpGen.compileLoopBody (map paramName acc_params) body'
+      block_size <-- 1
+
+      -- Check if loop is candidate for unrolling.
+      let loop =
+            case w of
+              Var w_var | Just w_bound <- lookup w_var $ kernelStreamed constants,
+                          w_bound /= Imp.ConstSize 1 ->
+                          -- Candidate for unrolling, so generate two loops.
+                          sIf (w' .==. Imp.sizeToExp w_bound)
+                          (sFor block_offset Int32 (Imp.sizeToExp w_bound) body'')
+                          (sFor block_offset Int32 w' body'')
+              _ -> sFor block_offset Int32 w' body''
+
+      if kernelThreadActive constants == Imp.ValueExp (BoolValue True)
+        then loop
+        else sWhen (kernelThreadActive constants) loop
+
+    _ -> do
+      dPrim_ block_offset int32
+      let body' = streaming constants block_size maxchunk $
+                  ImpGen.compileBody' acc_params body
+
+      block_offset <-- 0
+
+      let not_at_end = block_offset' .<. w'
+          set_block_size =
+            sIf (w' - block_offset' .<. max_block_size)
+            (block_size <-- (w' - block_offset'))
+            (block_size <-- max_block_size)
+          increase_offset =
+            block_offset <-- block_offset' + max_block_size
+
+      -- Three cases to consider for simpler generated code based
+      -- on max block size: (0) if full input size, do not
+      -- generate a loop; (1) if one, generate for-loop (2)
+      -- otherwise, generate chunked while-loop.
+      if max_block_size == w' then
+        (block_size <-- w') >> body'
+      else if max_block_size == Imp.ValueExp (value (1::Int32)) then do
+             block_size <-- w'
+             sFor block_offset Int32 w' body'
+           else
+             sWhile not_at_end $
+             set_block_size >> body' >> increase_offset
+
+  forM_ (zip final acc_params) $ \(pe, p) ->
+    ImpGen.copyDWIM (patElemName pe) [] (Var $ paramName p) []
+
+  where isSimpleThreadInSpace (Let _ _ Op{}) = Nothing
+        isSimpleThreadInSpace bnd = Just bnd
+
+compileKernelExp _ _ (GroupGenReduce w arrs op bucket values locks) = do
+  -- Check if bucket is in-bounds
+  bucket' <- mapM ImpGen.compileSubExp bucket
+  w' <- mapM ImpGen.compileSubExp w
+  sWhen (indexInBounds bucket' w') $
+    atomicUpdate arrs bucket op values locking
+  where indexInBounds inds bounds =
+          foldl1 (.&&.) $ zipWith checkBound inds bounds
+          where checkBound ind bound = 0 .<=. ind .&&. ind .<. bound
+        locking = Locking locks 0 1 0
+
+compileKernelExp _ dest e =
+  compilerBugS $ unlines ["Invalid target", "  " ++ show dest,
+                          "for kernel expression", "  " ++ pretty e]
+
+-- | Locking strategy used for an atomic update.
+data Locking = Locking { lockingArray :: VName -- ^ Array containing the lock.
+                       , lockingIsUnlocked :: Imp.Exp -- ^ Value for us to consider the lock free.
+                       , lockingToLock :: Imp.Exp -- ^ What to write when we lock it.
+                       , lockingToUnlock :: Imp.Exp -- ^ What to write when we unlock it.
+                       }
+
+groupReduce :: ExplicitMemorish lore =>
+               KernelConstants
+            -> SubExp
+            -> Lambda lore
+            -> [VName]
+            -> ImpGen.ImpM lore Imp.KernelOp ()
+groupReduce constants w lam arrs = do
+  w' <- ImpGen.compileSubExp w
+
+  let local_tid = kernelLocalThreadId constants
+      (reduce_i, reduce_j_param, actual_reduce_params) =
+        partitionChunkedKernelLambdaParameters $ lambdaParams lam
+      (reduce_acc_params, reduce_arr_params) =
+        splitAt (length arrs) actual_reduce_params
+      reduce_j = paramName reduce_j_param
+
+  offset <- dPrim "offset" int32
+
+  skip_waves <- dPrim "skip_waves" int32
+  ImpGen.dLParams $ lambdaParams lam
+
+  reduce_i <-- Imp.var local_tid int32
+
+  let setOffset x = do
+        offset <-- x
+        reduce_j <-- Imp.var local_tid int32 + Imp.var offset int32
+
+  setOffset 0
+
+  sWhen (Imp.var local_tid int32 .<. w') $
+    zipWithM_ (readReduceArgument offset) reduce_acc_params arrs
+
+  let read_reduce_args = zipWithM_ (readReduceArgument offset)
+                         reduce_arr_params arrs
+      do_reduce = do ImpGen.comment "read array element" read_reduce_args
+                     ImpGen.compileBody' reduce_acc_params $ lambdaBody lam
+                     zipWithM_ (writeReduceOpResult local_tid)
+                       reduce_acc_params arrs
+      in_wave_reduce = ImpGen.everythingVolatile do_reduce
+
+      wave_size = Imp.sizeToExp $ kernelWaveSize constants
+      group_size = Imp.sizeToExp $ kernelGroupSize constants
+      wave_id = Imp.var local_tid int32 `quot` wave_size
+      in_wave_id = Imp.var local_tid int32 - wave_id * wave_size
+      num_waves = (group_size + wave_size - 1) `quot` wave_size
+      arg_in_bounds = Imp.var reduce_j int32 .<. w'
+
+      doing_in_wave_reductions =
+        Imp.var offset int32 .<. wave_size
+      apply_in_in_wave_iteration =
+        (in_wave_id .&. (2 * Imp.var offset int32 - 1)) .==. 0
+      in_wave_reductions = do
+        setOffset 1
+        sWhile doing_in_wave_reductions $ do
+          sWhen (arg_in_bounds .&&. apply_in_in_wave_iteration)
+            in_wave_reduce
+          setOffset $ Imp.var offset int32 * 2
+
+      doing_cross_wave_reductions =
+        Imp.var skip_waves int32 .<. num_waves
+      is_first_thread_in_wave =
+        in_wave_id .==. 0
+      wave_not_skipped =
+        (wave_id .&. (2 * Imp.var skip_waves int32 - 1)) .==. 0
+      apply_in_cross_wave_iteration =
+        arg_in_bounds .&&. is_first_thread_in_wave .&&. wave_not_skipped
+      cross_wave_reductions = do
+        skip_waves <-- 1
+        sWhile doing_cross_wave_reductions $ do
+          sOp Imp.Barrier
+          setOffset (Imp.var skip_waves int32 * wave_size)
+          sWhen apply_in_cross_wave_iteration
+            do_reduce
+          skip_waves <-- Imp.var skip_waves int32 * 2
+
+  in_wave_reductions
+  cross_wave_reductions
+  where readReduceArgument offset param arr
+          | Prim _ <- paramType param =
+              ImpGen.copyDWIM (paramName param) [] (Var arr) [i]
+          | otherwise =
+              return ()
+          where i = ImpGen.varIndex (kernelLocalThreadId constants) + ImpGen.varIndex offset
+
+        writeReduceOpResult i param arr
+          | Prim _ <- paramType param =
+              ImpGen.copyDWIM arr [ImpGen.varIndex i] (Var $ paramName param) []
+          | otherwise =
+              return ()
+
+atomicUpdate :: ExplicitMemorish lore =>
+                [VName] -> [SubExp] -> Lambda lore -> [SubExp] -> Locking
+             -> ImpGen.ImpM lore Imp.KernelOp ()
+atomicUpdate [a] bucket op [v] _
+  | [Prim t] <- lambdaReturnType op,
+    primBitSize t == 32 = do
+  -- If we have only one array and one non-array value (this is a
+  -- one-to-one correspondance) then we need only one
+  -- update. If operator has an atomic implementation we use
+  -- that, otherwise it is still a binary operator which can
+  -- be implemented by atomic compare-and-swap if 32 bits.
+
+  -- Common variables.
+  old <- dPrim "old" t
+  bucket' <- mapM ImpGen.compileSubExp bucket
+
+  (arr', _a_space, bucket_offset) <- ImpGen.fullyIndexArray a bucket'
+
+  val' <- ImpGen.compileSubExp v
+  case opHasAtomicSupport old arr' bucket_offset op of
+    Just f -> sOp $ f val'
+
+    Nothing -> do
+      -- Code generation target:
+      --
+      -- old = d_his[idx];
+      -- do {
+      --   assumed = old;
+      --   tmp = OP::apply(val, assumed);
+      --   old = atomicCAS(&d_his[idx], assumed, tmp);
+      -- } while(assumed != old);
+      assumed <- dPrim "assumed" t
+      run_loop <- dPrimV "run_loop" true
+      ImpGen.copyDWIM old [] (Var a) bucket'
+
+        -- Preparing parameters
+      let (acc_p:arr_p:_) = lambdaParams op
+
+      -- Critical section
+      ImpGen.dLParams $ lambdaParams op
+
+      -- While-loop: Try to insert your value
+      let (toBits, fromBits) =
+            case t of FloatType Float32 -> (\x -> Imp.FunExp "to_bits32" [x] int32,
+                                            \x -> Imp.FunExp "from_bits32" [x] t)
+                      _                 -> (id, id)
+      sWhile (Imp.var run_loop Bool) $ do
+        assumed <-- Imp.var old t
+        paramName acc_p <-- val'
+        paramName arr_p <-- Imp.var assumed t
+        ImpGen.compileBody' [acc_p] $ lambdaBody op
+        old_bits <- dPrim "old_bits" int32
+        sOp $ Imp.Atomic $
+          Imp.AtomicCmpXchg old_bits arr' bucket_offset
+          (toBits (Imp.var assumed int32)) (toBits (Imp.var (paramName acc_p) int32))
+        old <-- fromBits (Imp.var old_bits int32)
+        sWhen (toBits (Imp.var assumed t) .==. Imp.var old_bits int32)
+          (run_loop <-- false)
+  where opHasAtomicSupport old arr' bucket' lam = do
+          let atomic f = Imp.Atomic . f old arr' bucket'
+          [BasicOp (BinOp bop _ _)] <-
+            Just $ map stmExp $ stmsToList $ bodyStms $ lambdaBody lam
+          atomic <$> Imp.atomicBinOp bop
+
+atomicUpdate arrs bucket op values locking = do
+  old <- dPrim "old" int32
+  loop_done <- dPrimV "loop_done" 0
+
+  -- Check if bucket is in-bounds
+  bucket' <- mapM ImpGen.compileSubExp bucket
+
+  -- Correctly index into locks.
+  (locks', _locks_space, locks_offset) <-
+    ImpGen.fullyIndexArray (lockingArray locking) bucket'
+
+  -- Preparing parameters
+  let (acc_params, arr_params) =
+        splitAt (length values) $ lambdaParams op
+
+  -- Critical section
+  let try_acquire_lock =
+        sOp $ Imp.Atomic $
+        Imp.AtomicCmpXchg old locks' locks_offset (lockingIsUnlocked locking) (lockingToLock locking)
+      lock_acquired = Imp.var old int32 .==. lockingIsUnlocked locking
+      loop_cond = Imp.var loop_done int32 .==. 0
+      release_lock = ImpGen.everythingVolatile $
+                     ImpGen.sWrite (lockingArray locking) bucket' $ lockingToUnlock locking
+      break_loop = loop_done <-- 1
+
+  -- We copy the current value and the new value to the parameters
+  -- unless they are array-typed.  If they are arrays, then the
+  -- index functions should already be set up correctly, so there is
+  -- nothing more to do.
+  let bind_acc_params =
+        forM_ (zip acc_params arrs) $ \(acc_p, arr) ->
+        when (primType (paramType acc_p)) $
+        ImpGen.copyDWIM (paramName acc_p) [] (Var arr) bucket'
+
+  let bind_arr_params =
+        forM_ (zip arr_params values) $ \(arr_p, val) ->
+        when (primType (paramType arr_p)) $
+        ImpGen.copyDWIM (paramName arr_p) [] val []
+
+  let op_body = ImpGen.compileBody' acc_params $ lambdaBody op
+
+      do_gen_reduce = zipWithM_ (writeArray bucket') arrs $ map (Var . paramName) acc_params
+
+  -- While-loop: Try to insert your value
+  sWhile loop_cond $ do
+    try_acquire_lock
+    sWhen lock_acquired $ do
+      ImpGen.dLParams $ lambdaParams op
+      bind_acc_params
+      bind_arr_params
+      op_body
+      do_gen_reduce
+      release_lock
+      break_loop
+    sOp Imp.MemFence
+  where writeArray bucket' arr val =
+          ImpGen.copyDWIM arr bucket' val []
+
+allThreads :: KernelConstants -> InKernelGen () -> InKernelGen ()
+allThreads constants = ImpGen.emit <=< ImpGen.subImpM_ (inKernelOperations constants')
+  where constants' =
+          constants { kernelThreadActive = Imp.ValueExp (BoolValue True) }
+
+streaming :: KernelConstants -> VName -> SubExp -> InKernelGen () -> InKernelGen ()
+streaming constants chunksize bound m = do
+  bound' <- ImpGen.subExpToDimSize bound
+  let constants' =
+        constants { kernelStreamed = (chunksize, bound') : kernelStreamed constants }
+  ImpGen.emit =<< ImpGen.subImpM_ (inKernelOperations constants') m
+
+compileKernelResult :: KernelConstants -> PatElem InKernel -> KernelResult
+                    -> InKernelGen ()
+
+compileKernelResult constants pe (ThreadsReturn OneResultPerGroup what) = do
+  i <- newVName "i"
+
+  in_local_memory <- arrayInLocalMemory what
+  let me = Imp.var (kernelLocalThreadId constants) int32
+
+  if not in_local_memory then do
+    who' <- ImpGen.compileSubExp $ intConst Int32 0
+    sWhen (me .==. who') $
+      ImpGen.copyDWIM (patElemName pe) [ImpGen.varIndex $ kernelGroupId constants] what []
+    else do
+      -- If the result of the group is an array in local memory, we
+      -- store it by collective copying among all the threads of the
+      -- group.  TODO: also do this if the array is in global memory
+      -- (but this is a bit more tricky, synchronisation-wise).
+      --
+      -- We do the reads/writes multidimensionally, but the loop is
+      -- single-dimensional.
+      ws <- mapM ImpGen.compileSubExp . arrayDims =<< subExpType what
+      -- Compute how many elements this thread is responsible for.
+      -- Formula: (w - ltid) / group_size (rounded up).
+      let w = product ws
+          ltid = ImpGen.varIndex (kernelLocalThreadId constants)
+          group_size = Imp.sizeToExp (kernelGroupSize constants)
+          to_write = (w - ltid) `quotRoundingUp` group_size
+          is = unflattenIndex ws $ ImpGen.varIndex i * group_size + ltid
+
+      sFor i Int32 to_write $
+        ImpGen.copyDWIM (patElemName pe) (ImpGen.varIndex (kernelGroupId constants) : is) what is
+
+compileKernelResult constants pe (ThreadsReturn AllThreads what) =
+  ImpGen.copyDWIM (patElemName pe) [ImpGen.varIndex $ kernelGlobalThreadId constants] what []
+
+compileKernelResult constants pe (ThreadsReturn (ThreadsPerGroup limit) what) =
+  sWhen (isActive limit) $
+  ImpGen.copyDWIM (patElemName pe) [ImpGen.varIndex $ kernelGroupId constants] what []
+
+compileKernelResult constants pe (ThreadsReturn ThreadsInSpace what) = do
+  let is = map (ImpGen.varIndex . fst) $ kernelDimensions constants
+  sWhen (kernelThreadActive constants) $ ImpGen.copyDWIM (patElemName pe) is what []
+
+compileKernelResult constants pe (ConcatReturns SplitContiguous _ per_thread_elems moffset what) = do
+  dest_loc <- ImpGen.entryArrayLocation <$> ImpGen.lookupArray (patElemName pe)
+  let dest_loc_offset = ImpGen.offsetArray dest_loc offset
+      dest' = ImpGen.arrayDestination dest_loc_offset
+  ImpGen.copyDWIMDest dest' [] (Var what) []
+  where offset = case moffset of
+                   Nothing -> ImpGen.compileSubExpOfType int32 per_thread_elems *
+                              ImpGen.varIndex (kernelGlobalThreadId constants)
+                   Just se -> ImpGen.compileSubExpOfType int32 se
+
+compileKernelResult constants pe (ConcatReturns (SplitStrided stride) _ _ moffset what) = do
+  dest_loc <- ImpGen.entryArrayLocation <$> ImpGen.lookupArray (patElemName pe)
+  let dest_loc' = ImpGen.strideArray
+                  (ImpGen.offsetArray dest_loc offset) $
+                  ImpGen.compileSubExpOfType int32 stride
+      dest' = ImpGen.arrayDestination dest_loc'
+  ImpGen.copyDWIMDest dest' [] (Var what) []
+  where offset = case moffset of
+                   Nothing -> ImpGen.varIndex (kernelGlobalThreadId constants)
+                   Just se -> ImpGen.compileSubExpOfType int32 se
+
+compileKernelResult constants pe (WriteReturn rws _arr dests) = do
+  rws' <- mapM ImpGen.compileSubExp rws
+  forM_ dests $ \(is, e) -> do
+    is' <- mapM ImpGen.compileSubExp is
+    let condInBounds i rw = 0 .<=. i .&&. i .<. rw
+        write = foldl (.&&.) (kernelThreadActive constants) $
+                zipWith condInBounds is' rws'
+    sWhen write $ ImpGen.copyDWIM (patElemName pe) (map (ImpGen.compileSubExpOfType int32) is) e []
+
+compileKernelResult _ _ KernelInPlaceReturn{} =
+  -- Already in its place... said it was a hack.
+  return ()
+
+isActive :: [(VName, SubExp)] -> Imp.Exp
+isActive limit = case actives of
+                    [] -> Imp.ValueExp $ BoolValue True
+                    x:xs -> foldl (.&&.) x xs
+  where (is, ws) = unzip limit
+        actives = zipWith active is $ map (ImpGen.compileSubExpOfType Bool) ws
+        active i = (Imp.var i int32 .<.)
+
+setSpaceIndices :: KernelSpace -> InKernelGen ()
+setSpaceIndices space =
+  case spaceStructure space of
+    FlatThreadSpace is_and_dims ->
+      flatSpaceWith gtid is_and_dims
+    NestedThreadSpace is_and_dims -> do
+      let (gtids, gdims, ltids, ldims) = unzip4 is_and_dims
+      gdims' <- mapM ImpGen.compileSubExp gdims
+      ldims' <- mapM ImpGen.compileSubExp ldims
+      let (gtid_es, ltid_es) = unzip $ unflattenNestedIndex gdims' ldims' gtid
+      zipWithM_ (<--) gtids gtid_es
+      zipWithM_ (<--) ltids ltid_es
+  where gtid = Imp.var (spaceGlobalId space) int32
+
+        flatSpaceWith base is_and_dims = do
+          let (is, dims) = unzip is_and_dims
+          dims' <- mapM ImpGen.compileSubExp dims
+          let index_expressions = unflattenIndex dims' base
+          zipWithM_ (<--) is index_expressions
 
 unflattenNestedIndex :: IntegralExp num => [num] -> [num] -> num -> [(num,num)]
 unflattenNestedIndex global_dims group_dims global_id =
diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs b/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs
--- a/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs
+++ b/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs
@@ -20,8 +20,6 @@
 import qualified Language.C.Quote.OpenCL as C
 
 import Futhark.Error
-import Futhark.Representation.AST.Attributes.Types (int32)
-import qualified Futhark.CodeGen.OpenCL.Kernels as Kernels
 import qualified Futhark.CodeGen.Backends.GenericC as GenericC
 import Futhark.CodeGen.Backends.SimpleRepresentation
 import Futhark.CodeGen.ImpCode.Kernels hiding (Program)
@@ -31,7 +29,6 @@
 import Futhark.MonadFreshNames
 import Futhark.Util (zEncodeString)
 import Futhark.Util.Pretty (pretty, prettyOneLine)
-import Futhark.Util.IntegralExp (quotRoundingUp)
 
 -- | Translate a kernels-program to an OpenCL-program.
 kernelsToOpenCL :: ImpKernels.Program
@@ -128,7 +125,9 @@
   return $ LaunchKernel
     (calledKernelName called) (kernelArgs called) kernel_size workgroup_size
 
-  where (kernel_size, workgroup_size) = kernelAndWorkgroupSize called
+  where kernel_size = [sizeToExp (mapKernelNumGroups kernel) *
+                       sizeToExp (mapKernelGroupSize kernel)]
+        workgroup_size = [sizeToExp $ mapKernelGroupSize kernel]
 
 onKernel called@(AnyKernel kernel) = do
   let (kernel_body, _) =
@@ -167,18 +166,8 @@
           return (Nothing,
                   [C.citem|ALIGNED_LOCAL_MEMORY($id:mem, $exp:size');|])
         name = calledKernelName called
-        (kernel_size, workgroup_size) = kernelAndWorkgroupSize called
-
-onKernel (MapTranspose bt
-          destmem destoffset
-          srcmem srcoffset
-          num_arrays x_elems y_elems in_elems out_elems) = do
-  generateTransposeFunction bt
-  return $ HostCode $ Call [] (transposeName bt)
-    [MemArg destmem, ExpArg destoffset,
-     MemArg srcmem, ExpArg srcoffset,
-     ExpArg num_arrays, ExpArg x_elems, ExpArg y_elems,
-     ExpArg in_elems, ExpArg out_elems]
+        kernel_size = zipWith (*) (kernelNumGroups kernel) (kernelGroupSize kernel)
+        workgroup_size = kernelGroupSize kernel
 
 useAsParam :: KernelUse -> Maybe C.Param
 useAsParam (ScalarUse name bt) =
@@ -187,7 +176,7 @@
         Bool -> [C.cty|unsigned char|]
         _    -> GenericC.primTypeToCType bt
   in Just [C.cparam|$ty:ctp $id:name|]
-useAsParam (MemoryUse name _) =
+useAsParam (MemoryUse name) =
   Just [C.cparam|__global unsigned char *$id:name|]
 useAsParam ConstUse{} =
   Nothing
@@ -249,9 +238,7 @@
 calledKernelName (Map k) =
   mapKernelName k
 calledKernelName (AnyKernel k) =
-  kernelDesc k ++ "_kernel_" ++ show (baseTag $ kernelName k)
-calledKernelName (MapTranspose bt _ _ _ _ _ _ _ _ _) =
-  transposeKernelName bt Kernels.TransposeNormal
+  nameToString $ kernelName k
 
 kernelArgs :: CallKernel -> [KernelArg]
 kernelArgs (Map kernel) =
@@ -262,33 +249,7 @@
   mapMaybe useToArg (kernelUses kernel)
   where localMemorySize (_, Left size) = Just size
         localMemorySize (_, Right{}) = Nothing
-kernelArgs (MapTranspose bt destmem destoffset srcmem srcoffset _ x_elems y_elems in_elems out_elems) =
-  [ MemKArg destmem
-  , ValueKArg destoffset int32
-  , MemKArg srcmem
-  , ValueKArg srcoffset int32
-  , ValueKArg x_elems int32
-  , ValueKArg y_elems int32
-  , ValueKArg in_elems int32
-  , ValueKArg out_elems int32
-  , SharedMemoryKArg shared_memory
-  ]
-  where shared_memory =
-          bytes $ (transposeBlockDim + 1) * transposeBlockDim *
-          LeafExp (SizeOf bt) (IntType Int32)
 
-kernelAndWorkgroupSize :: CallKernel -> ([Exp], [Exp])
-kernelAndWorkgroupSize (Map kernel) =
-  ([sizeToExp (mapKernelNumGroups kernel) *
-    sizeToExp (mapKernelGroupSize kernel)],
-   [sizeToExp $ mapKernelGroupSize kernel])
-kernelAndWorkgroupSize (AnyKernel kernel) =
-  ([sizeToExp (kernelNumGroups kernel) *
-    sizeToExp (kernelGroupSize kernel)],
-   [sizeToExp $ kernelGroupSize kernel])
-kernelAndWorkgroupSize (MapTranspose _ _ _ _ _ num_arrays x_elems y_elems _ _) =
-  transposeKernelAndGroupSize num_arrays x_elems y_elems
-
 --- Generating C
 
 inKernelOperations :: GenericC.Operations KernelOp UsedFunctions
@@ -393,213 +354,16 @@
           quals <- pointerQuals space
           return [C.cty|$tyquals:quals $ty:defaultMemBlockType|]
 
---- Handling transpositions
-
-transposeKernelName :: PrimType -> Kernels.TransposeType -> String
-transposeKernelName bt Kernels.TransposeNormal =
-  "fut_kernel_map_transpose_" ++ pretty bt
-transposeKernelName bt Kernels.TransposeLowWidth =
-  "fut_kernel_map_transpose_lowwidth_" ++ pretty bt
-transposeKernelName bt Kernels.TransposeLowHeight =
-  "fut_kernel_map_transpose_lowheight_" ++ pretty bt
-transposeKernelName bt Kernels.TransposeSmall =
-  "fut_kernel_map_transpose_small_" ++ pretty bt
-
-transposeName :: PrimType -> Name
-transposeName bt = nameFromString $ "map_transpose_opencl_" ++ pretty bt
-
-generateTransposeFunction :: PrimType -> OnKernelM ()
-generateTransposeFunction bt =
-  -- We have special functions to handle transposing an input array with low
-  -- width or low height, as this would cause very few threads to be active. See
-  -- comment in Futhark.CodeGen.OpenCL.OpenCL.Kernels.hs for more details.
-
-  tell mempty
-    { clExtraFuns = M.singleton (transposeName bt) $
-                    ImpOpenCL.Function False [] params transpose_code [] []
-    , clKernels = M.fromList $
-        map (\tt -> let name = transposeKernelName bt tt
-                    in (name, Kernels.mapTranspose name bt' tt))
-        [Kernels.TransposeNormal, Kernels.TransposeLowWidth,
-         Kernels.TransposeLowHeight, Kernels.TransposeSmall]
-
-    , clRequirements = mempty
-    }
-
-  where bt' = GenericC.primTypeToCType bt
-        space = ImpOpenCL.Space "device"
-        memparam s i = MemParam (VName (nameFromString s) i) space
-        intparam s i = ScalarParam (VName (nameFromString s) i) $ IntType Int32
-
-        params = [destmem_p, destoffset_p, srcmem_p, srcoffset_p,
-                num_arrays_p, x_p, y_p, in_p, out_p]
-
-        [destmem_p, destoffset_p, srcmem_p, srcoffset_p,
-                num_arrays_p, x_p, y_p, in_p, out_p,
-                muly, new_height, mulx, new_width] =
-          zipWith ($) [memparam "destmem",
-                       intparam "destoffset",
-                       memparam "srcmem",
-                       intparam "srcoffset",
-                       intparam "num_arrays",
-                       intparam "x_elems",
-                       intparam "y_elems",
-                       intparam "in_elems",
-                       intparam "out_elems",
-                       -- The following is only used for low width/height
-                       -- transpose kernels
-                       intparam "muly",
-                       intparam "new_height",
-                       intparam "mulx",
-                       intparam "new_width"
-                      ]
-                      [0..]
-
-        asExp param =
-          ImpOpenCL.LeafExp (ImpOpenCL.ScalarVar (paramName param)) (IntType Int32)
-
-        asArg (MemParam name _) =
-          MemKArg name
-        asArg (ScalarParam name t) =
-          ValueKArg (ImpOpenCL.LeafExp (ImpOpenCL.ScalarVar name) t) t
-
-        normal_kernel_args =
-          map asArg [destmem_p, destoffset_p, srcmem_p, srcoffset_p,
-                     x_p, y_p, in_p, out_p] ++
-          [SharedMemoryKArg shared_memory]
-
-        lowwidth_kernel_args =
-          map asArg [destmem_p, destoffset_p, srcmem_p, srcoffset_p,
-                     x_p, y_p, in_p, out_p, muly] ++
-          [SharedMemoryKArg shared_memory]
-
-        lowheight_kernel_args =
-          map asArg [destmem_p, destoffset_p, srcmem_p, srcoffset_p,
-                     x_p, y_p, in_p, out_p, mulx] ++
-          [SharedMemoryKArg shared_memory]
-
-        shared_memory =
-          bytes $ (transposeBlockDim + 1) * transposeBlockDim *
-          LeafExp (SizeOf bt) (IntType Int32)
-
-        transposeBlockDimDivTwo = BinOpExp (SQuot Int32) transposeBlockDim 2
-
-        should_use_lowwidth = BinOpExp LogAnd
-          (CmpOpExp (CmpSle Int32) (asExp x_p) transposeBlockDimDivTwo)
-          (CmpOpExp (CmpSlt Int32) transposeBlockDim (asExp y_p))
-
-        should_use_lowheight = BinOpExp LogAnd
-          (CmpOpExp (CmpSle Int32) (asExp y_p) transposeBlockDimDivTwo)
-          (CmpOpExp (CmpSlt Int32) transposeBlockDim (asExp x_p))
-
-        should_use_small = BinOpExp LogAnd
-          (CmpOpExp (CmpSle Int32) (asExp x_p) transposeBlockDimDivTwo)
-          (CmpOpExp (CmpSle Int32) (asExp y_p) transposeBlockDimDivTwo)
-
-        -- When an input array has either width==1 or height==1, performing a
-        -- transpose will be the same as performing a copy.  If 'input_size' or
-        -- 'output_size' is not equal to width*height, then this trick will not
-        -- work when there are more than one array to process, as it is a per
-        -- array limit. We could copy each array individually, but currently we
-        -- do not.
-        can_use_copy =
-          let in_out_eq = CmpOpExp (CmpEq $ IntType Int32) (asExp in_p) (asExp out_p)
-              onearr = CmpOpExp (CmpEq $ IntType Int32) (asExp num_arrays_p) 1
-              noprob_widthheight = CmpOpExp (CmpEq $ IntType Int32)
-                                     (asExp x_p * asExp y_p)
-                                     (asExp in_p)
-              height_is_one = CmpOpExp (CmpEq $ IntType Int32) (asExp y_p) 1
-              width_is_one = CmpOpExp (CmpEq $ IntType Int32) (asExp x_p) 1
-          in BinOpExp LogAnd
-               in_out_eq
-               (BinOpExp LogAnd
-                 (BinOpExp LogOr onearr noprob_widthheight)
-                 (BinOpExp LogOr width_is_one height_is_one))
-
-        input_is_empty = CmpOpExp (CmpEq $ IntType Int32)
-                         (asExp num_arrays_p * asExp x_p * asExp y_p) 0
-
-        transpose_code =
-          ImpOpenCL.If input_is_empty mempty
-          (ImpOpenCL.If can_use_copy
-            copy_code
-            (ImpOpenCL.If should_use_lowwidth
-              lowwidth_transpose_code
-              (ImpOpenCL.If should_use_lowheight
-                lowheight_transpose_code
-                (ImpOpenCL.If should_use_small
-                  small_transpose_code
-                  normal_transpose_code))))
-
-        copy_code =
-          let num_bytes =
-                asExp in_p * ImpOpenCL.LeafExp (ImpOpenCL.SizeOf bt) (IntType Int32)
-          in ImpOpenCL.Copy
-               (paramName destmem_p) (Count $ asExp destoffset_p) space
-               (paramName srcmem_p) (Count $ asExp srcoffset_p) space
-               (Count num_bytes)
-
-        normal_transpose_code =
-          let (kernel_size, workgroup_size) =
-                transposeKernelAndGroupSize (asExp num_arrays_p) (asExp x_p) (asExp y_p)
-          in ImpOpenCL.Op $ LaunchKernel
-             (transposeKernelName bt Kernels.TransposeNormal) normal_kernel_args kernel_size workgroup_size
-
-        small_transpose_code =
-          let group_size = (transposeBlockDim * transposeBlockDim)
-              kernel_size = (asExp num_arrays_p * asExp x_p * asExp y_p) `roundUpTo`
-                            group_size
-          in ImpOpenCL.Op $ LaunchKernel
-             (transposeKernelName bt Kernels.TransposeSmall)
-             (map asArg [destmem_p, destoffset_p, srcmem_p, srcoffset_p,
-                         num_arrays_p, x_p, y_p, in_p, out_p])
-             [kernel_size] [group_size]
-
-        lowwidth_transpose_code =
-          let set_muly = DeclareScalar (paramName muly) (IntType Int32)
-                        :>>: SetScalar (paramName muly) (BinOpExp (SQuot Int32) transposeBlockDim (asExp x_p))
-              set_new_height = DeclareScalar (paramName new_height) (IntType Int32)
-                :>>: SetScalar (paramName new_height) (asExp y_p `quotRoundingUp` asExp muly)
-              (kernel_size, workgroup_size) =
-                transposeKernelAndGroupSize (asExp num_arrays_p) (asExp x_p) (asExp new_height)
-              launch = ImpOpenCL.Op $ LaunchKernel
-                (transposeKernelName bt Kernels.TransposeLowWidth) lowwidth_kernel_args kernel_size workgroup_size
-          in set_muly :>>: set_new_height :>>: launch
-
-        lowheight_transpose_code =
-          let set_mulx = DeclareScalar (paramName mulx) (IntType Int32)
-                        :>>: SetScalar (paramName mulx) (BinOpExp (SQuot Int32) transposeBlockDim (asExp y_p))
-              set_new_width = DeclareScalar (paramName new_width) (IntType Int32)
-                :>>: SetScalar (paramName new_width) (asExp x_p `quotRoundingUp` asExp mulx)
-              (kernel_size, workgroup_size) =
-                transposeKernelAndGroupSize (asExp num_arrays_p) (asExp new_width) (asExp y_p)
-              launch = ImpOpenCL.Op $ LaunchKernel
-                (transposeKernelName bt Kernels.TransposeLowHeight) lowheight_kernel_args kernel_size workgroup_size
-          in set_mulx :>>: set_new_width :>>: launch
-
-transposeKernelAndGroupSize :: ImpOpenCL.Exp -> ImpOpenCL.Exp -> ImpOpenCL.Exp
-                            -> ([ImpOpenCL.Exp], [ImpOpenCL.Exp])
-transposeKernelAndGroupSize num_arrays x_elems y_elems =
-  ([(x_elems `roundUpTo` transposeBlockDim) *
-    (y_elems `roundUpTo` transposeBlockDim) *
-    num_arrays],
-   [transposeBlockDim * transposeBlockDim])
-
-roundUpTo :: ImpOpenCL.Exp -> ImpOpenCL.Exp -> ImpOpenCL.Exp
-roundUpTo x y = x + ((y - (x `impRem` y)) `impRem` y)
-  where impRem = BinOpExp $ SRem Int32
-
 --- Checking requirements
 
 useToArg :: KernelUse -> Maybe KernelArg
-useToArg (MemoryUse mem _) = Just $ MemKArg mem
-useToArg (ScalarUse v bt)  = Just $ ValueKArg (LeafExp (ScalarVar v) bt) bt
-useToArg ConstUse{}        = Nothing
+useToArg (MemoryUse mem)  = Just $ MemKArg mem
+useToArg (ScalarUse v bt) = Just $ ValueKArg (LeafExp (ScalarVar v) bt) bt
+useToArg ConstUse{}       = Nothing
 
 typesInKernel :: CallKernel -> S.Set PrimType
 typesInKernel (Map kernel) = typesInCode $ mapKernelBody kernel
 typesInKernel (AnyKernel kernel) = typesInCode $ kernelBody kernel
-typesInKernel MapTranspose{} = mempty
 
 typesInCode :: ImpKernels.KernelCode -> S.Set PrimType
 typesInCode Skip = mempty
diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/Transpose.hs b/src/Futhark/CodeGen/ImpGen/Kernels/Transpose.hs
new file mode 100644
--- /dev/null
+++ b/src/Futhark/CodeGen/ImpGen/Kernels/Transpose.hs
@@ -0,0 +1,277 @@
+module Futhark.CodeGen.ImpGen.Kernels.Transpose
+  ( TransposeType(..)
+  , TransposeArgs
+  , mapTranspose
+  , mapTransposeKernel
+  )
+  where
+
+import qualified Data.Set as S
+import Data.Semigroup ((<>))
+
+import Prelude hiding (quot, rem)
+
+import Futhark.CodeGen.ImpCode.Kernels
+import Futhark.Representation.AST.Attributes.Types
+import Futhark.Representation.AST.Attributes.Names (freeIn)
+import Futhark.Util.IntegralExp (IntegralExp, quot, rem, quotRoundingUp)
+
+-- | Which form of transposition to generate code for.
+data TransposeType = TransposeNormal
+                   | TransposeLowWidth
+                   | TransposeLowHeight
+                   | TransposeSmall -- ^ For small arrays that do not
+                                    -- benefit from coalescing.
+                   deriving (Eq, Ord, Show)
+
+type TransposeArgs = (VName, Exp,
+                      VName, Exp,
+                      Exp, Exp, Exp, Exp,
+                      Exp, Exp, Exp,
+                      VName)
+
+elemsPerThread :: IntegralExp a => a
+elemsPerThread = 4
+
+-- | Generate a transpose kernel.  There is special support to handle
+-- input arrays with low width, low height, or both.
+--
+-- Normally when transposing a @[2][n]@ array we would use a @FUT_BLOCK_DIM x
+-- FUT_BLOCK_DIM@ group to process a @[2][FUT_BLOCK_DIM]@ slice of the input
+-- array. This would mean that many of the threads in a group would be inactive.
+-- We try to remedy this by using a special kernel that will process a larger
+-- part of the input, by using more complex indexing. In our example, we could
+-- use all threads in a group if we are processing @(2/FUT_BLOCK_DIM)@ as large
+-- a slice of each rows per group. The variable 'mulx' contains this factor for
+-- the kernel to handle input arrays with low height.
+--
+-- See issue #308 on GitHub for more details.
+--
+-- These kernels are optimized to ensure all global reads and writes
+-- are coalesced, and to avoid bank conflicts in shared memory.  Each
+-- thread group transposes a 2D tile of block_dim*2 by block_dim*2
+-- elements. The size of a thread group is block_dim/2 by
+-- block_dim*2, meaning that each thread will process 4 elements in a
+-- 2D tile.  The shared memory array containing the 2D tile consists
+-- of block_dim*2 by block_dim*2+1 elements. Padding each row with
+-- an additional element prevents bank conflicts from occuring when
+-- the tile is accessed column-wise.
+--
+-- Note that input_size and output_size may not equal width*height if
+-- we are dealing with a truncated array - this happens sometimes for
+-- coalescing optimisations.
+mapTranspose :: Exp -> TransposeArgs -> PrimType -> TransposeType -> KernelCode
+mapTranspose block_dim args t kind =
+  case kind of
+    TransposeSmall ->
+      mconcat
+      [ get_ids
+
+      , dec our_array_offset $ v32 get_global_id_0 `quot` (height*width) * (height*width)
+
+      , dec x_index $ (v32 get_global_id_0 `rem` (height*width)) `quot` height
+      , dec y_index $ v32 get_global_id_0 `rem` height
+
+      , dec odata_offset $
+        (basic_odata_offset `quot` primByteSize t) + v32 our_array_offset
+      , dec idata_offset $
+        (basic_idata_offset `quot` primByteSize t) + v32 our_array_offset
+
+      , dec index_in $ v32 y_index * width + v32 x_index
+      , dec index_out $ v32 x_index * height + v32 y_index
+
+      , If (v32 get_global_id_0 .<. input_size)
+        (Write odata (bytes $ (v32 odata_offset + v32 index_out) * tsize) t (Space "global") Nonvolatile $
+         index idata (bytes $ (v32 idata_offset + v32 index_in) * tsize) t (Space "global") Nonvolatile)
+        mempty
+      ]
+
+    TransposeLowWidth ->
+      mkTranspose $ lowDimBody
+      (v32 get_group_id_0 * block_dim + (v32 get_local_id_0 `quot` muly))
+      (v32 get_group_id_1 * block_dim * muly + v32 get_local_id_1 +
+       (v32 get_local_id_0 `rem` muly) * block_dim)
+      (v32 get_group_id_1* block_dim * muly + v32 get_local_id_0 +
+       (v32 get_local_id_1 `rem` muly) * block_dim)
+      (v32 get_group_id_0 * block_dim + (v32 get_local_id_1 `quot` muly))
+
+    TransposeLowHeight ->
+      mkTranspose $ lowDimBody
+      (v32 get_group_id_0 * block_dim * mulx + v32 get_local_id_0 +
+       (v32 get_local_id_1 `rem` mulx) * block_dim)
+      (v32 get_group_id_1 * block_dim + (v32 get_local_id_1 `quot` mulx))
+      (v32 get_group_id_1 * block_dim + (v32 get_local_id_0 `quot` mulx))
+      (v32 get_group_id_0 * block_dim * mulx + v32 get_local_id_1 +
+       (v32 get_local_id_0 `rem` mulx) * block_dim)
+
+    TransposeNormal ->
+      mkTranspose $ mconcat
+      [ dec x_index $ v32 get_global_id_0
+      , dec y_index $ v32 get_group_id_1 * tile_dim + v32 get_local_id_1
+      , when (v32 x_index .<. width) $
+        For j Int32 elemsPerThread $
+        let i = v32 j * (tile_dim `quot` elemsPerThread)
+        in mconcat [ dec index_in $ (v32 y_index + i) * width + v32 x_index
+                   , when (v32 y_index + i .<. height .&&.
+                           v32 index_in .<. input_size) $
+                     Write block (bytes $ ((v32 get_local_id_1 + i) * (tile_dim+1)
+                                           + v32 get_local_id_0) * tsize)
+                     t (Space "local") Nonvolatile $
+                     index idata (bytes $ (v32 idata_offset + v32 index_in) * tsize)
+                     t (Space "global") Nonvolatile]
+      , Op Barrier
+      , SetScalar x_index $ v32 get_group_id_1 * tile_dim + v32 get_local_id_0
+      , SetScalar y_index $ v32 get_group_id_0 * tile_dim + v32 get_local_id_1
+      , when (v32 x_index .<. height) $
+        For j Int32 elemsPerThread $
+        let i = v32 j * (tile_dim `quot` elemsPerThread)
+        in mconcat [ dec index_out $ (v32 y_index + i) * height + v32 x_index
+                   , when (v32 y_index + i .<. width .&&.
+                           v32 index_out .<. output_size) $
+                     Write odata (bytes $ (v32 odata_offset + v32 index_out) * tsize)
+                     t (Space "global") Nonvolatile $
+                     index block (bytes $ (v32 get_local_id_0 * (tile_dim+1)
+                                           +v32 get_local_id_1+i)*tsize)
+                     t (Space "local") Nonvolatile
+                   ]
+      ]
+
+  where dec v e = DeclareScalar v int32 <> SetScalar v e
+        v32 = flip var int32
+        tsize = LeafExp (SizeOf t) int32
+        tile_dim = 2 * block_dim
+
+        when a b = If a b mempty
+
+        (odata, basic_odata_offset, idata, basic_idata_offset,
+         width, height, input_size, output_size,
+         mulx, muly, _num_arrays, block) = args
+
+        -- Be extremely careful when editing this list to ensure that
+        -- the names match up.  Also, be careful that the tags on
+        -- these names do not conflicts with the tags of the
+        -- surrounding code.  We accomplish the latter by using very
+        -- low tags (normal variables start at least in the low
+        -- hundreds).
+        [   our_array_offset , x_index , y_index
+          , odata_offset, idata_offset, index_in, index_out
+          , get_global_id_0
+          , get_local_id_0, get_local_id_1
+          , get_group_id_0, get_group_id_1, get_group_id_2
+          , j] =
+          zipWith (flip VName) [30..] $ map nameFromString
+          [ "our_array_offset" , "x_index" , "y_index"
+          , "odata_offset", "idata_offset", "index_in", "index_out"
+          , "get_global_id_0"
+          , "get_local_id_0", "get_local_id_1"
+          , "get_group_id_0", "get_group_id_1", "get_group_id_2"
+          , "j"]
+
+        get_ids =
+          mconcat [ DeclareScalar get_global_id_0 int32
+                  , Op $ GetGlobalId get_global_id_0 0
+                  , DeclareScalar get_local_id_0 int32
+                  , Op $ GetLocalId get_local_id_0 0
+                  , DeclareScalar get_local_id_1 int32
+                  , Op $ GetLocalId get_local_id_1 1
+                  , DeclareScalar get_group_id_0 int32
+                  , Op $ GetGroupId get_group_id_0 0
+                  , DeclareScalar get_group_id_1 int32
+                  , Op $ GetGroupId get_group_id_1 1
+                  , DeclareScalar get_group_id_2 int32
+                  , Op $ GetGroupId get_group_id_2 2
+                  ]
+
+        mkTranspose body =
+          mconcat
+          [ get_ids
+          , dec our_array_offset $ v32 get_group_id_2 * width * height
+          , dec odata_offset $
+            (basic_odata_offset `quot` primByteSize t) + v32 our_array_offset
+          , dec idata_offset $
+            (basic_idata_offset `quot` primByteSize t) + v32 our_array_offset
+          , body
+          ]
+
+        lowDimBody x_in_index y_in_index x_out_index y_out_index =
+          mconcat
+          [ dec x_index x_in_index
+          , dec y_index y_in_index
+          , dec index_in $ v32 y_index * width + v32 x_index
+          , when (v32 x_index .<. width .&&. v32 y_index .<. height .&&. v32 index_in .<. input_size) $
+            Write block (bytes $ (v32 get_local_id_1 * (block_dim+1) + v32 get_local_id_0) * tsize)
+            t (Space "local") Nonvolatile $
+            index idata (bytes $ (v32 idata_offset + v32 index_in) * tsize)
+            t (Space "global") Nonvolatile
+          , Op Barrier
+          , SetScalar x_index x_out_index
+          , SetScalar y_index y_out_index
+          , dec index_out $ v32 y_index * height + v32 x_index
+          , when (v32 x_index .<. height .&&. v32 y_index .<. width .&&. v32 index_out .<. output_size) $
+            Write odata (bytes $ (v32 odata_offset + v32 index_out) * tsize)
+            t (Space "global") Nonvolatile $
+            index block (bytes $ (v32 get_local_id_0 * (block_dim+1)
+                                   +v32 get_local_id_1)*tsize)
+            t (Space "local") Nonvolatile
+          ]
+
+mapTransposeKernel :: String -> Integer -> TransposeArgs -> PrimType -> TransposeType
+                   -> Kernel
+mapTransposeKernel desc block_dim_int args t kind =
+  Kernel
+  { kernelBody = mapTranspose block_dim args t kind
+  , kernelLocalMemory = [(block, Right block_size)]
+  , kernelUses = uses
+  , kernelNumGroups = num_groups
+  , kernelGroupSize = group_size
+  , kernelName = nameFromString name
+  }
+  where pad2DBytes k = k * (k + 1) * primByteSize t
+        block_size =
+          case kind of TransposeSmall -> 1 -- Not used, but AMD's
+                                           -- OpenCL does not like
+                                           -- zero-size local memory.
+                       TransposeNormal -> fromInteger $ pad2DBytes $ 2*block_dim_int
+                       TransposeLowWidth -> fromInteger $ pad2DBytes block_dim_int
+                       TransposeLowHeight -> fromInteger $ pad2DBytes block_dim_int
+        block_dim = fromInteger block_dim_int
+
+        (odata, basic_odata_offset, idata, basic_idata_offset,
+         width, height, input_size, output_size,
+         mulx, muly, num_arrays,
+         block) = args
+
+        (num_groups, group_size) =
+          case kind of
+            TransposeSmall ->
+              ([(num_arrays * width * height) `quotRoundingUp` (block_dim * block_dim)],
+               [block_dim * block_dim])
+            TransposeLowWidth ->
+              lowDimKernelAndGroupSize block_dim num_arrays width $ height `quotRoundingUp` muly
+            TransposeLowHeight ->
+              lowDimKernelAndGroupSize block_dim num_arrays (width `quotRoundingUp` mulx) height
+            TransposeNormal ->
+              let actual_dim = block_dim*2
+              in ( [ width `quotRoundingUp` actual_dim
+                   , height `quotRoundingUp` actual_dim
+                   , num_arrays]
+                 , [actual_dim, actual_dim `quot` elemsPerThread, 1])
+
+        uses = map (`ScalarUse` int32)
+               (S.toList $ mconcat $ map freeIn
+                [basic_odata_offset, basic_idata_offset, num_arrays,
+                 width, height, input_size, output_size, mulx, muly]) ++
+               map MemoryUse [odata, idata]
+
+        name =
+          case kind of TransposeSmall -> desc ++ "_small"
+                       TransposeLowHeight -> desc ++ "_low_height"
+                       TransposeLowWidth -> desc ++ "_low_width"
+                       TransposeNormal -> desc
+
+lowDimKernelAndGroupSize :: Exp -> Exp -> Exp -> Exp -> ([Exp], [Exp])
+lowDimKernelAndGroupSize block_dim num_arrays x_elems y_elems =
+  ([x_elems `quotRoundingUp` block_dim,
+    y_elems `quotRoundingUp` block_dim,
+    num_arrays],
+   [block_dim, block_dim, 1])
diff --git a/src/Futhark/CodeGen/OpenCL/Kernels.hs b/src/Futhark/CodeGen/OpenCL/Kernels.hs
--- a/src/Futhark/CodeGen/OpenCL/Kernels.hs
+++ b/src/Futhark/CodeGen/OpenCL/Kernels.hs
@@ -1,19 +1,12 @@
-{-# LANGUAGE QuasiQuotes #-}
 module Futhark.CodeGen.OpenCL.Kernels
        ( SizeHeuristic (..)
        , DeviceType (..)
        , WhichSize (..)
        , HeuristicValue (..)
        , sizeHeuristicsTable
-
-       , mapTranspose
-       , TransposeType(..)
        )
        where
 
-import qualified Language.C.Syntax as C
-import qualified Language.C.Quote.OpenCL as C
-
 -- Some OpenCL platforms have a SIMD/warp/wavefront-based execution
 -- model that execute groups of threads in lockstep, permitting us to
 -- perform cross-thread synchronisation within each such group without
@@ -60,171 +53,3 @@
   , SizeHeuristic "" DeviceCPU GroupSize $ HeuristicConst 32
   , SizeHeuristic "" DeviceCPU TileSize $ HeuristicConst 4
   ]
-
--- | Which form of transposition to generate code for.
-data TransposeType = TransposeNormal
-                   | TransposeLowWidth
-                   | TransposeLowHeight
-                   | TransposeSmall -- ^ For small arrays that do not
-                                    -- benefit from coalescing.
-                   deriving (Eq, Ord, Show)
-
--- | @mapTranspose name elem_type transpose_type@ Generate a transpose kernel
--- with requested @name@ for elements of type @elem_type@. There are special
--- support to handle input arrays with low width or low height, which can be
--- indicated by @transpose_type@.
---
--- Normally when transposing a @[2][n]@ array we would use a @FUT_BLOCK_DIM x
--- FUT_BLOCK_DIM@ group to process a @[2][FUT_BLOCK_DIM]@ slice of the input
--- array. This would mean that many of the threads in a group would be inactive.
--- We try to remedy this by using a special kernel that will process a larger
--- part of the input, by using more complex indexing. In our example, we could
--- use all threads in a group if we are processing @(2/FUT_BLOCK_DIM)@ as large
--- a slice of each rows per group. The variable 'mulx' contains this factor for
--- the kernel to handle input arrays with low height.
---
--- See issue #308 on GitHub for more details.
-mapTranspose :: C.ToIdent a => a -> C.Type -> TransposeType -> C.Func
-mapTranspose kernel_name elem_type transpose_type =
-  case transpose_type of
-    TransposeNormal ->
-      bigKernel []
-      [C.cexp|global_id_x|]
-      [C.cexp|global_id_y|]
-      [C.cexp|group_id_y * FUT_BLOCK_DIM + local_id_x|]
-      [C.cexp|group_id_x * FUT_BLOCK_DIM + local_id_y|]
-      (toNumGroups [C.cexp|width|])
-      (toNumGroups [C.cexp|height|])
-    TransposeLowWidth ->
-      bigKernel [C.cparams|uint muly|]
-      [C.cexp|group_id_x * FUT_BLOCK_DIM + (local_id_x / muly)|]
-      [C.cexp|group_id_y * FUT_BLOCK_DIM * muly
-           + local_id_y
-           + (local_id_x % muly) * FUT_BLOCK_DIM
-          |]
-      [C.cexp|group_id_y * FUT_BLOCK_DIM * muly
-           + local_id_x
-           + (local_id_y % muly) * FUT_BLOCK_DIM|]
-      [C.cexp|group_id_x * FUT_BLOCK_DIM + (local_id_y / muly)|]
-      (toNumGroups [C.cexp|width|])
-      (toNumGroups [C.cexp|(height + muly - 1) / muly|])
-    TransposeLowHeight ->
-      bigKernel [C.cparams|uint mulx|]
-      [C.cexp|group_id_x * FUT_BLOCK_DIM * mulx
-           + local_id_x
-           + (local_id_y % mulx) * FUT_BLOCK_DIM
-          |]
-      [C.cexp|group_id_y * FUT_BLOCK_DIM + (local_id_y / mulx)|]
-      [C.cexp|group_id_y * FUT_BLOCK_DIM + (local_id_x / mulx)|]
-      [C.cexp|group_id_x * FUT_BLOCK_DIM * mulx
-           + local_id_y
-           + (local_id_x % mulx) * FUT_BLOCK_DIM
-           |]
-      (toNumGroups [C.cexp|(width + mulx - 1) / mulx|])
-      (toNumGroups [C.cexp|height|])
-    TransposeSmall ->
-      smallKernel
-  where
-    toNumGroups e = [C.cexp|($exp:e + FUT_BLOCK_DIM - 1) / FUT_BLOCK_DIM|]
-    bigKernel extraparams x_in_index y_in_index x_out_index y_out_index ngrpx ngrpy =
-      [C.cfun|
-       // This kernel is optimized to ensure all global reads and writes are coalesced,
-       // and to avoid bank conflicts in shared memory.  The shared memory array is sized
-       // to (BLOCK_DIM+1)*BLOCK_DIM.  This pads each row of the 2D block in shared memory
-       // so that bank conflicts do not occur when threads address the array column-wise.
-       //
-       // Note that input_size/output_size may not equal width*height if we are dealing with
-       // a truncated array - this happens sometimes for coalescing optimisations.
-       __kernel void $id:kernel_name($params:params) {
-         uint num_groups_y = $exp:ngrpy;
-         uint num_groups_x = $exp:ngrpx;
-         uint num_groups_z = ((uint)get_num_groups(0)) /  (num_groups_y * num_groups_x);
-
-         uint local_id_y = ((uint)get_local_id(0)) / FUT_BLOCK_DIM;
-         uint local_id_x = ((uint)get_local_id(0)) % FUT_BLOCK_DIM;
-         uint group_id_z = ((uint)get_group_id(0)) / (num_groups_y * num_groups_x);
-         uint group_id_yx = ((uint)get_group_id(0)) % (num_groups_y * num_groups_x);
-         uint group_id_y = group_id_yx / num_groups_x;
-         uint group_id_x = group_id_yx % num_groups_x;
-
-         uint global_id_z = group_id_z;
-         uint global_id_y = group_id_y * FUT_BLOCK_DIM + local_id_y;
-         uint global_id_x = group_id_x * FUT_BLOCK_DIM + local_id_x;
-
-         uint x_index;
-         uint y_index;
-         uint our_array_offset;
-
-         // Adjust the input and output arrays with the basic offset.
-         odata += odata_offset/sizeof($ty:elem_type);
-         idata += idata_offset/sizeof($ty:elem_type);
-
-         // Adjust the input and output arrays for the third dimension.
-         our_array_offset = global_id_z * width * height;
-         odata += our_array_offset;
-         idata += our_array_offset;
-
-         // read the matrix tile into shared memory
-         x_index = $exp:x_in_index;
-         y_index = $exp:y_in_index;
-
-         uint index_in = y_index * width + x_index;
-
-         if(x_index < width && y_index < height && index_in < input_size)
-         {
-             block[local_id_y*(FUT_BLOCK_DIM+1)+local_id_x] = idata[index_in];
-         }
-
-         barrier(CLK_LOCAL_MEM_FENCE);
-
-         // Scatter the transposed matrix tile to global memory.
-         x_index = $exp:x_out_index;
-         y_index = $exp:y_out_index;
-
-         uint index_out = y_index * height + x_index;
-
-         if(x_index < height && y_index < width && index_out < output_size)
-         {
-             odata[index_out] = block[local_id_x*(FUT_BLOCK_DIM+1)+local_id_y];
-         }
-       }|]
-           where params = [C.cparams|__global $ty:elem_type *odata,
-                                uint odata_offset,
-                                __global $ty:elem_type *idata,
-                                uint idata_offset,
-                                uint width,
-                                uint height,
-                                uint input_size,
-                                uint output_size|] ++ extraparams ++
-                          [C.cparams|__local $ty:elem_type* block|]
-
-    smallKernel =
-      [C.cfun|
-         __kernel void $id:kernel_name(__global $ty:elem_type *odata,
-                                      uint odata_offset,
-                                      __global $ty:elem_type *idata,
-                                      uint idata_offset,
-                                      uint num_arrays,
-                                      uint width,
-                                      uint height,
-                                      uint input_size,
-                                      uint output_size) {
-           uint our_array_offset = get_global_id(0) / (height*width) * (height*width);
-           uint x_index = get_global_id(0) % (height*width) / height;
-           uint y_index = get_global_id(0) % height;
-
-           // Adjust the input and output arrays with the basic offset.
-           odata += odata_offset/sizeof($ty:elem_type);
-           idata += idata_offset/sizeof($ty:elem_type);
-
-           // Adjust the input and output arrays.
-           odata += our_array_offset;
-           idata += our_array_offset;
-
-           // Read and write the element.
-           uint index_in = y_index * width + x_index;
-           uint index_out = x_index * height + y_index;
-           if (get_global_id(0) < input_size) {
-               odata[index_out] = idata[index_in];
-           }
-}|]
diff --git a/src/Futhark/Compiler/CLI.hs b/src/Futhark/Compiler/CLI.hs
--- a/src/Futhark/Compiler/CLI.hs
+++ b/src/Futhark/Compiler/CLI.hs
@@ -13,6 +13,7 @@
 import Data.Maybe
 import System.FilePath
 import System.Console.GetOpt
+import System.IO
 
 import Futhark.Pipeline
 import Futhark.Compiler
@@ -30,10 +31,12 @@
              -> (cfg -> CompilerMode -> FilePath -> Prog lore -> FutharkM ())
              -- ^ The action to take on the result of the pipeline.
              -> IO ()
-compilerMain cfg cfg_opts name desc pipeline doIt =
+compilerMain cfg cfg_opts name desc pipeline doIt = do
+  hSetEncoding stdout utf8
+  hSetEncoding stderr utf8
   reportingIOErrors $
-  mainWithOptions (newCompilerConfig cfg) (commandLineOptions ++ map wrapOption cfg_opts)
-  "options... program" inspectNonOptions
+    mainWithOptions (newCompilerConfig cfg) (commandLineOptions ++ map wrapOption cfg_opts)
+    "options... program" inspectNonOptions
   where inspectNonOptions [file] config = Just $ compile config file
         inspectNonOptions _      _      = Nothing
 
diff --git a/src/Futhark/Compiler/Program.hs b/src/Futhark/Compiler/Program.hs
--- a/src/Futhark/Compiler/Program.hs
+++ b/src/Futhark/Compiler/Program.hs
@@ -188,4 +188,6 @@
 prependRoots roots (E.Prog doc ds) =
   E.Prog doc $ map mkImport roots ++ ds
   where mkImport fp =
-          E.LocalDec (E.OpenDec (E.ModImport fp E.NoInfo noLoc) E.NoInfo noLoc) noLoc
+          -- We do not use ImportDec here, because we do not want the
+          -- type checker to issue a warning about a redundant import.
+          E.LocalDec (E.OpenDec (E.ModImport fp E.NoInfo noLoc) noLoc) noLoc
diff --git a/src/Futhark/Doc/Generator.hs b/src/Futhark/Doc/Generator.hs
--- a/src/Futhark/Doc/Generator.hs
+++ b/src/Futhark/Doc/Generator.hs
@@ -275,7 +275,7 @@
   ModDec m -> synopsisMod fm m
   ValDec v -> synopsisValBind v
   TypeDec t -> synopsisType t
-  OpenDec x (Info _names) _
+  OpenDec x _
     | Just opened <- synopsisOpened x -> Just $ do
         opened' <- opened
         return $ fullRow $ keyword "open " <> opened'
@@ -285,7 +285,8 @@
   LocalDec (SigDec s) _
     | sigName s `S.member` visible ->
         synopsisModType (keyword "local" <> " ") s
-  LocalDec _ _ -> Nothing
+  LocalDec{} -> Nothing
+  ImportDec{} -> Nothing
 
 synopsisOpened :: ModExp -> Maybe (DocM Html)
 synopsisOpened (ModVar qn _) = Just $ qualNameHtml qn
@@ -377,6 +378,9 @@
   t' <- typeHtml t
   return $ keyword "val " <> vnameHtml name <> joinBy " " tps' <> ": " <> t'
 
+prettyEnum :: [Name] -> Html
+prettyEnum cs = pipes $ map (("#"<>) . renderName) cs
+
 typeHtml :: StructType -> DocM Html
 typeHtml t = case t of
   Prim et -> return $ primTypeHtml et
@@ -404,6 +408,7 @@
         parens (vnameHtml v <> ": " <> t1') <> " -> " <> t2'
       Nothing ->
         t1' <> " -> " <> t2'
+  Enum cs -> return $ prettyEnum cs
 
 prettyElem :: ArrayElemTypeBase (DimDecl VName) () -> DocM Html
 prettyElem (ArrayPrimElem et _) = return $ primTypeHtml et
@@ -418,6 +423,7 @@
   where ppField (name, tp) = do
           tp' <- prettyRecordElem tp
           return $ toHtml (nameToString name) <> ": " <> tp'
+prettyElem (ArrayEnumElem cs _ ) = return $ braces $ prettyEnum cs
 
 prettyRecordElem :: RecordArrayElemTypeBase (DimDecl VName) () -> DocM Html
 prettyRecordElem (RecordArrayElem et) = prettyElem et
@@ -485,10 +491,10 @@
 synopsisSpec spec = case spec of
   TypeAbbrSpec tpsig ->
     fullRow <$> typeBindHtml (vnameSynopsisDef $ typeAlias tpsig) tpsig
-  TypeSpec Unlifted name ps _ _ ->
-    return $ fullRow $ keyword "type " <> vnameSynopsisDef name <> joinBy " " (map typeParamHtml ps)
-  TypeSpec Lifted name ps _ _ ->
-    return $ fullRow $ keyword "type" <> "^" <> vnameSynopsisDef name <> joinBy " " (map typeParamHtml ps)
+  TypeSpec l name ps _ _ ->
+    return $ fullRow $ keyword l' <> vnameSynopsisDef name <> mconcat (map ((" "<>) . typeParamHtml) ps)
+    where l' = case l of Unlifted -> "type "
+                         Lifted   -> "type^ "
   ValSpec name tparams rettype _ _ -> do
     let tparams' = map typeParamHtml tparams
     rettype' <- noLink (map typeParamName tparams) $
@@ -529,6 +535,7 @@
         parens (vnameHtml v <> ": " <> t1') <> " -> " <> t2'
       Nothing ->
         t1' <> " -> " <> t2'
+  TEEnum cs _ -> return $ prettyEnum cs
 
 qualNameHtml :: QualName VName -> DocM Html
 qualNameHtml (QualName names vname@(VName name tag)) =
@@ -703,6 +710,7 @@
   return $ keyword "local module type " <> name'
 
 describeDec _ LocalDec{} = Nothing
+describeDec _ ImportDec{} = Nothing
 
 valBindWhat :: ValBind -> IndexWhat
 valBindWhat vb =
diff --git a/src/Futhark/Doc/Html.hs b/src/Futhark/Doc/Html.hs
--- a/src/Futhark/Doc/Html.hs
+++ b/src/Futhark/Doc/Html.hs
@@ -8,6 +8,7 @@
   , brackets
   , braces
   , parens
+  , pipes
   )
 where
 
@@ -44,7 +45,11 @@
 
 parens :: Html -> Html
 parens x = toHtml "(" <> x <> toHtml ")"
+
 braces :: Html -> Html
 braces x = toHtml "{" <> x <> toHtml "}"
 brackets :: Html -> Html
 brackets x = toHtml "[" <> x <> toHtml "]"
+
+pipes :: [Html] -> Html
+pipes = joinBy (toHtml " | ")
diff --git a/src/Futhark/Internalise.hs b/src/Futhark/Internalise.hs
--- a/src/Futhark/Internalise.hs
+++ b/src/Futhark/Internalise.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fmax-pmcheck-iterations=2500000#-}
 -- |
 --
 -- This module implements a transformation from source to core
@@ -17,6 +18,7 @@
 import Data.List
 import Data.Loc
 import Data.Char (chr)
+import Data.Maybe
 
 import Language.Futhark as E hiding (TypeArg)
 import Language.Futhark.Semantic (Imports)
@@ -122,7 +124,7 @@
     zeroExts ts = generaliseExtTypes ts ts
 
 generateEntryPoint :: E.ValBind -> InternaliseM ()
-generateEntryPoint (E.ValBind _ ofname retdecl (Info rettype) _ orig_params _ _ loc) =
+generateEntryPoint (E.ValBind _ ofname retdecl (Info rettype) _ params _ _ loc) =
   -- We remove all shape annotations, so there should be no constant
   -- parameters here.
   bindingParams [] (map E.patternNoShapeAnnotations params) $
@@ -142,14 +144,6 @@
       (concat entry_rettype)
       (shapeparams ++ concat params') entry_body
 
-  -- XXX: We massage the parameters a little bit to handle the case
-  -- where there is just a single parameter that is a tuple.  This is
-  -- wide-spread in existing Futhark code, although I'd like to get
-  -- rid of it.
-  where params = case orig_params of
-          [TuplePattern ps _] -> ps
-          _                   -> orig_params
-
 entryPoint :: [(E.Pattern,[I.FParam])]
            -> (Maybe (E.TypeExp VName), E.StructType, [[I.TypeBase ExtShape Uniqueness]])
            -> EntryPoint
@@ -182,9 +176,27 @@
           [I.TypeDirect]
         entryPointType (te, t, ts) =
           [I.TypeOpaque desc $ length ts]
-          where desc = maybe (pretty t') pretty te
+          where desc = maybe (pretty t') typeExpOpaqueName te
                 t' = removeShapeAnnotations t `E.setUniqueness` Nonunique
 
+        -- | We remove dimension arguments such that we hopefully end
+        -- up with a simpler type name for the entry point.  The
+        -- intend is that if an entry point uses a type 'nasty [w] [h]',
+        -- then we should turn that into an opaque type just called
+        -- 'nasty'.  Also, we try to give arrays of opaques a nicer name.
+        typeExpOpaqueName (TEApply te TypeArgExpDim{} _) =
+          typeExpOpaqueName te
+        typeExpOpaqueName (TEArray te _ _) =
+          let (d, te') = withoutDims te
+          in "arr_" ++ typeExpOpaqueName te' ++
+             "_" ++ show (1 + d) ++ "d"
+        typeExpOpaqueName te = pretty te
+
+        withoutDims (TEArray te _ _) =
+          let (d, te') = withoutDims te
+          in (d+1, te')
+        withoutDims te = (0::Int, te)
+
 internaliseIdent :: E.Ident -> InternaliseM I.VName
 internaliseIdent (E.Ident name (Info tp) loc) =
   case tp of
@@ -421,15 +433,8 @@
            args' <- concat <$> mapM (internaliseExp "arg") args
            fst <$> funcall desc qfname args' loc
 
-internaliseExp desc (E.LetPat tparams pat e body loc) = do
-  ses <- internaliseExp desc e
-  t <- I.staticShapes <$> mapM I.subExpType ses
-  stmPattern tparams pat t $ \cm pat_names match -> do
-    mapM_ (uncurry (internaliseDimConstant loc)) cm
-    ses' <- match loc ses
-    forM_ (zip pat_names ses') $ \(v,se) ->
-      letBindNames_ [v] $ I.BasicOp $ I.SubExp se
-    internaliseExp desc body
+internaliseExp desc (E.LetPat tparams pat e body loc) =
+  internalisePat desc tparams pat e body loc (internaliseExp desc)
 
 internaliseExp desc (E.LetFun ofname (tparams, params, retdecl, Info rettype, body) letbody loc) = do
   internaliseValBind $ E.ValBind False ofname retdecl (Info rettype) tparams params body Nothing loc
@@ -578,47 +583,27 @@
                    init_loop_cond_bnds))
 
 internaliseExp desc (E.LetWith name src idxs ve body loc) = do
-  srcs <- internaliseExpToVars "src" $
-          E.Var (qualName (E.identName src)) (vacuousShapeAnnotations <$> E.identType src)
-          (srclocOf src)
+  let pat = E.Id (E.identName name) (E.vacuousShapeAnnotations <$> E.identType name) loc
+      src_t = E.fromStruct . E.vacuousShapeAnnotations <$> E.identType src
+      e = E.Update (E.Var (E.qualName $ E.identName src) src_t loc) idxs ve loc
+  internaliseExp desc $ E.LetPat [] pat e body loc
+
+internaliseExp desc (E.Update src slice ve loc) = do
   ves <- internaliseExp "lw_val" ve
+  srcs <- internaliseExpToVars "src" src
   dims <- case srcs of
             [] -> return [] -- Will this happen?
             v:_ -> I.arrayDims <$> lookupType v
-  (idxs', cs) <- internaliseSlice loc dims idxs
+  (idxs', cs) <- internaliseSlice loc dims slice
+
   let comb sname ve' = do
         sname_t <- lookupType sname
-        let slice = fullSlice sname_t idxs'
-            rowtype = sname_t `setArrayDims` sliceDims slice
+        let full_slice = fullSlice sname_t idxs'
+            rowtype = sname_t `setArrayDims` sliceDims full_slice
         ve'' <- ensureShape asserting "shape of value does not match shape of source array"
                 loc rowtype "lw_val_correct_shape" ve'
-        certifying cs $
-          letInPlace "letwith_dst" sname (fullSlice sname_t idxs') $ BasicOp $ SubExp ve''
-  dsts <- zipWithM comb srcs ves
-  dstt <- I.staticShapes <$> mapM lookupType dsts
-  let pat = E.Id (E.identName name)
-            (E.vacuousShapeAnnotations <$> E.identType name)
-            (srclocOf name)
-  stmPattern [] pat dstt $ \cm pat_names match -> do
-    mapM_ (uncurry (internaliseDimConstant loc)) cm
-    dsts' <- match loc $ map I.Var dsts
-    forM_ (zip pat_names dsts') $ \(v,dst) ->
-      letBindNames_ [v] $ I.BasicOp $ I.SubExp dst
-    internaliseExp desc body
-
-internaliseExp desc (E.Update src slice ve loc) = do
-  src_name <- newVName "update_src"
-  dest_name <- newVName "update_dest"
-  let src_t = E.typeOf src
-      src_ident = E.Ident src_name (E.Info src_t) loc
-      dest_ident = E.Ident dest_name (E.Info src_t) loc
-
-  internaliseExp desc $
-    E.LetPat [] (E.Id src_name (E.Info $ E.vacuousShapeAnnotations src_t) loc) src
-    (E.LetWith dest_ident src_ident slice ve
-      (E.Var (E.qualName dest_name) (E.Info (E.vacuousShapeAnnotations src_t)) loc)
-      loc)
-    loc
+        letInPlace desc sname full_slice $ BasicOp $ SubExp ve''
+  certifying cs $ map I.Var <$> zipWithM comb srcs ves
 
 internaliseExp desc (E.RecordUpdate src fields ve _ _) = do
   src' <- internaliseExp desc src
@@ -816,6 +801,28 @@
   w <- arraysSize 0 <$> mapM lookupType arrs
   letTupExp' desc $ I.Op $ I.Stream w form lam' arrs
 
+internaliseExp _ (E.VConstr0 c (Info t) loc) =
+  case t of
+    Enum cs ->
+      case elemIndex c $ sort cs of
+        Just i -> return [I.Constant $ I.IntValue $ intValue I.Int8 i]
+        _      -> fail $ "internaliseExp: invalid constructor: #" ++ nameToString c ++
+                         "\nfor enum at " ++ locStr loc ++ ": " ++ pretty t
+    _ -> fail $ "internaliseExp: nonsensical type for enum at "
+                ++ locStr loc ++ ": " ++ pretty t
+
+internaliseExp desc (E.Match  e cs _ loc) =
+  case cs of
+    [CasePat _ eCase _] -> internaliseExp desc eCase
+    (c:cs') -> do
+      bFalse <- bFalseM
+      letTupExp' desc =<< generateCaseIf desc e c bFalse
+      where bFalseM = do
+              eLast' <- internalisePat desc [] pLast e eLast locLast internaliseBody
+              foldM (\bf c' -> eBody $ return $ generateCaseIf desc e c' bf) eLast' (reverse $ init cs')
+            CasePat pLast eLast locLast = last cs'
+    [] -> fail $ "internaliseExp: match with no cases at: " ++ locStr loc
+
 -- The "interesting" cases are over, now it's mostly boilerplate.
 
 internaliseExp _ (E.Literal v _) =
@@ -880,6 +887,61 @@
 internaliseExp _ e@E.IndexSection{} =
   fail $ "internaliseExp: Unexpected index section at " ++ locStr (srclocOf e)
 
+andExp :: E.Exp -> E.Exp -> E.Exp
+andExp l r = E.If l r (E.Literal (E.BoolValue False) noLoc) (Info (E.Prim E.Bool)) noLoc
+
+eqExp :: E.Exp -> E.Exp -> E.Exp
+eqExp l r = E.BinOp eq (Info $ vacuousShapeAnnotations ft)
+            (l, sType l) (r, sType r) (Info (E.Prim E.Bool)) noLoc
+  where sType e = Info $ toStruct $ vacuousShapeAnnotations $ E.typeOf e
+        arrow   = Arrow S.empty Nothing
+        ft      = E.typeOf l `arrow` E.typeOf r `arrow` E.Prim E.Bool
+        eq      = qualName $ VName "==" (-1)
+
+generateCond :: E.Pattern -> E.Exp -> E.Exp
+generateCond p e = foldr andExp (E.Literal (E.BoolValue True) noLoc) conds
+  where conds = mapMaybe ((<*> pure e) . fst) $ generateCond' p
+
+        generateCond' :: E.Pattern -> [(Maybe (E.Exp -> E.Exp), CompType)]
+        generateCond' (E.TuplePattern ps loc) = generateCond' (E.RecordPattern fs loc)
+          where fs = zipWith (\i p' -> (nameFromString (show i), p')) ([1..] :: [Integer]) ps
+        generateCond' (E.RecordPattern fs _) = concatMap instCond holes
+          where holes = map (\(n, p') -> (generateCond' p', n)) fs
+                field ([],_) = Nothing
+                field ((_, t):_, f) = Just (f, t)
+                t' = Record $ M.fromList $ mapMaybe field holes
+                projectHole _ (Nothing, _) = (Nothing, t')
+                projectHole f (Just condHole, t) =
+                  (Just (\e' -> condHole $ Project f e' (Info t) noLoc), t')
+                instCond (condHoles, f) = map (projectHole f) condHoles
+        generateCond' (E.PatternParens p' _) = generateCond' p'
+        generateCond' (E.Id _ (Info t) _) =
+          [(Nothing, removeShapeAnnotations t)]
+        generateCond' (E.Wildcard (Info t) _)=
+          [(Nothing, removeShapeAnnotations t)]
+        generateCond' (E.PatternAscription p' _ _) = generateCond' p'
+        generateCond' (E.PatternLit ePat (Info t) _) =
+          [(Just (eqExp ePat), removeShapeAnnotations t)]
+
+
+generateCaseIf :: String -> E.Exp -> Case -> I.Body -> InternaliseM I.Exp
+generateCaseIf desc e (CasePat p eCase loc) bFail = do
+  eCase' <- internalisePat desc [] p e eCase loc internaliseBody
+  eIf cond (return eCase') (return bFail)
+  where cond = BasicOp . SubExp <$> internaliseExp1 "cond" (generateCond p e)
+
+internalisePat :: String -> [TypeParamBase VName] -> E.Pattern -> E.Exp
+               -> E.Exp -> SrcLoc -> (E.Exp -> InternaliseM a) -> InternaliseM a
+internalisePat desc tparams p e body loc m = do
+  ses <- internaliseExp desc e
+  t <- I.staticShapes <$> mapM I.subExpType ses
+  stmPattern tparams p t $ \cm pat_names match -> do
+    mapM_ (uncurry (internaliseDimConstant loc)) cm
+    ses' <- match loc ses
+    forM_ (zip pat_names ses') $ \(v,se) ->
+      letBindNames_ [v] $ I.BasicOp $ I.SubExp se
+    m body
+
 internaliseSlice :: SrcLoc
                  -> [SubExp]
                  -> [E.DimIndex]
@@ -1689,6 +1751,8 @@
   arg' <- case arg of TypeArgExpType argt -> typeExpForError cm argt
                       TypeArgExpDim d _   -> pure <$> dimDeclForError cm d
   return $ t' ++ [" "] ++ arg'
+typeExpForError _ e@E.TEEnum{} =
+  return [ErrorString $ pretty e]
 
 dimDeclForError :: ConstParams -> E.DimDecl VName -> InternaliseM (ErrorMsgPart SubExp)
 dimDeclForError cm (NamedDim d) = do
diff --git a/src/Futhark/Internalise/Bindings.hs b/src/Futhark/Internalise/Bindings.hs
--- a/src/Futhark/Internalise/Bindings.hs
+++ b/src/Futhark/Internalise/Bindings.hs
@@ -140,6 +140,8 @@
           flattenPattern' $ E.TuplePattern (map snd $ sortFields $ M.fromList fs) loc
         flattenPattern' (E.PatternAscription p _ _) =
           flattenPattern' p
+        flattenPattern' (E.PatternLit _ t loc) =
+          flattenPattern' $ E.Wildcard t loc
 
 type MatchPattern = SrcLoc -> [I.SubExp] -> InternaliseM [I.SubExp]
 
diff --git a/src/Futhark/Internalise/Defunctionalise.hs b/src/Futhark/Internalise/Defunctionalise.hs
--- a/src/Futhark/Internalise/Defunctionalise.hs
+++ b/src/Futhark/Internalise/Defunctionalise.hs
@@ -310,13 +310,15 @@
   (e2', sv2) <- defuncExp e2
   let sv = staticField sv1 sv2 fs
   return (RecordUpdate e1' fs e2'
-           (Info $ vacuousShapeAnnotations $ typeFromSV sv) loc,
+           (Info $ vacuousShapeAnnotations $ typeFromSV sv1) loc,
           sv)
   where staticField (RecordSV svs) sv2 (f:fs') =
           case lookup f svs of
             Just sv -> RecordSV $
                        (f, staticField sv sv2 fs') : filter ((/=f) . fst) svs
             Nothing -> error "Invalid record projection."
+        staticField (Dynamic t@Record{}) sv2 fs'@(_:_) =
+          staticField (svFromType t) sv2 fs'
         staticField _ sv2 _ = sv2
 
 defuncExp e@(Map fun arr t loc) = do
@@ -379,10 +381,28 @@
   (e2', sv) <- defuncExp e2
   return (Assert e1' e2' desc loc, sv)
 
+defuncExp e@VConstr0{} = return (e, Dynamic $ typeOf e)
+
+defuncExp (Match e cs t loc) = do
+  (e', sv) <- defuncExp e
+  csPairs  <- mapM (defuncCase sv) cs
+  let cs' = map fst csPairs
+      sv' = case csPairs of
+              []   -> error "Matches must always have at least one case."
+              c':_ -> snd c'
+  return (Match e' cs' t loc, sv')
+
 -- | Same as 'defuncExp', except it ignores the static value.
 defuncExp' :: Exp -> DefM Exp
 defuncExp' = fmap fst . defuncExp
 
+defuncCase :: StaticVal -> Case -> DefM (Case, StaticVal)
+defuncCase sv (CasePat p e loc) = do
+  let p'  = updatePattern p sv
+      env = matchPatternSV p sv
+  (e', sv') <- localEnv env $ defuncExp e
+  return (CasePat p' e' loc, sv')
+
 -- | Defunctionalize the function argument to a SOAC by eta-expanding if
 -- necessary and then defunctionalizing the body of the introduced lambda.
 defuncSoacExp :: Exp -> DefM Exp
@@ -604,6 +624,7 @@
   Id vn (Info t) _        -> M.singleton vn $ Dynamic $ removeShapeAnnotations t
   Wildcard _ _            -> mempty
   PatternAscription p _ _ -> envFromPattern p
+  PatternLit{}            -> mempty
 
 -- | Create an environment that binds the shape parameters.
 envFromShapeParams :: [TypeParamBase VName] -> Env
@@ -702,6 +723,7 @@
   else M.singleton vn sv
 matchPatternSV (Wildcard _ _) _ = mempty
 matchPatternSV (PatternAscription pat _ _) sv = matchPatternSV pat sv
+matchPatternSV PatternLit{} _ = mempty
 matchPatternSV pat (Dynamic t) = matchPatternSV pat $ svFromType t
 matchPatternSV pat sv = error $ "Tried to match pattern " ++ pretty pat
                              ++ " with static value " ++ show sv ++ "."
@@ -733,6 +755,7 @@
   | orderZero . unInfo $ expandedType tydecl =
       PatternAscription (updatePattern pat sv) tydecl loc
   | otherwise = updatePattern pat sv
+updatePattern p@PatternLit{} _ = p
 updatePattern pat (Dynamic t) = updatePattern pat (svFromType t)
 updatePattern pat sv =
   error $ "Tried to update pattern " ++ pretty pat
@@ -842,6 +865,10 @@
   Unzip e _ _         -> freeVars e
   Unsafe e _          -> freeVars e
   Assert e1 e2 _ _    -> freeVars e1 <> freeVars e2
+  VConstr0{}          -> mempty
+  Match e cs _ _      -> freeVars e <> foldMap caseFV cs
+    where caseFV (CasePat p eCase _) = (names (patternDimNames p) <> freeVars eCase)
+                                       `without` patternVars p
 
 freeDimIndex :: DimIndexBase Info VName -> NameSet
 freeDimIndex (DimFix e) = freeVars e
diff --git a/src/Futhark/Internalise/Defunctorise.hs b/src/Futhark/Internalise/Defunctorise.hs
--- a/src/Futhark/Internalise/Defunctorise.hs
+++ b/src/Futhark/Internalise/Defunctorise.hs
@@ -273,9 +273,12 @@
       bindingNames [modName mb] $ do
         mod_scope <- transformModBind mb
         extendScope mod_scope $ mappend <$> transformDecs ds' <*> pure mod_scope
-    OpenDec e _ _ : ds' -> do
+    OpenDec e _ : ds' -> do
       scope <- modScope <$> evalModExp e
       extendScope scope $ mappend <$> transformDecs ds' <*> pure scope
+    ImportDec name name' loc : ds' ->
+      let d = LocalDec (OpenDec (ModImport name name' loc) loc) loc
+      in transformDecs $ d : ds'
 
 transformImports :: Imports -> TransformM ()
 transformImports [] = return ()
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
@@ -374,6 +374,15 @@
 transformExp (Assert e1 e2 desc loc) =
   Assert <$> transformExp e1 <*> transformExp e2 <*> pure desc <*> pure loc
 
+transformExp e@VConstr0{} = return e
+transformExp (Match e cs t loc) =
+  Match <$> transformExp e <*> mapM transformCase cs <*> pure t <*> pure loc
+
+transformCase :: Case -> MonoM Case
+transformCase (CasePat p e loc) = do
+  (p', rr) <- expandRecordPattern p
+  CasePat <$> pure p' <*> withRecordReplacements rr (transformExp e) <*> pure loc
+
 transformDimIndex :: DimIndexBase Info VName -> MonoM (DimIndexBase Info VName)
 transformDimIndex (DimFix e) = DimFix <$> transformExp e
 transformDimIndex (DimSlice me1 me2 me3) =
@@ -454,6 +463,7 @@
 expandRecordPattern (PatternAscription pat td loc) = do
   (pat', rr) <- expandRecordPattern pat
   return (PatternAscription pat' td loc, rr)
+expandRecordPattern (PatternLit e t loc) = return (PatternLit e t loc, mempty)
 
 -- | Monomorphize a polymorphic function at the types given in the instance
 -- list. Monomorphizes the body of the function as well. Returns the fresh name
@@ -464,7 +474,7 @@
   t' <- removeTypeVariablesInType t
   let bind_t = foldFunType (map (toStructural . patternType) params) $
                toStructural rettype
-      substs = typeSubsts bind_t t'
+      substs = M.map Subst $ typeSubsts bind_t t'
       rettype' = applySubst (`M.lookup` substs) rettype
       params' = map (substPattern $ applySubst (`M.lookup` substs)) params
 
@@ -515,18 +525,20 @@
   | Just t1' <- peelArray (arrayRank t1) t1,
     Just t2' <- peelArray (arrayRank t1) t2 =
       typeSubsts t1' t2'
+typeSubsts Enum{} Enum{} = mempty
 typeSubsts t1 t2 = error $ unlines ["typeSubsts: mismatched types:", pretty t1, pretty t2]
 
 -- | Perform a given substitution on the types in a pattern.
 substPattern :: (PatternType -> PatternType) -> Pattern -> Pattern
 substPattern f pat = case pat of
-  TuplePattern pats loc      -> TuplePattern (map (substPattern f) pats) loc
-  RecordPattern fs loc       -> RecordPattern (map substField fs) loc
+  TuplePattern pats loc       -> TuplePattern (map (substPattern f) pats) loc
+  RecordPattern fs loc        -> RecordPattern (map substField fs) loc
     where substField (n, p) = (n, substPattern f p)
-  PatternParens p loc        -> PatternParens (substPattern f p) loc
-  Id vn (Info tp) loc        -> Id vn (Info $ f tp) loc
-  Wildcard (Info tp) loc     -> Wildcard (Info $ f tp) loc
-  PatternAscription p td loc -> PatternAscription (substPattern f p) td loc
+  PatternParens p loc         -> PatternParens (substPattern f p) loc
+  Id vn (Info tp) loc         -> Id vn (Info $ f tp) loc
+  Wildcard (Info tp) loc      -> Wildcard (Info $ f tp) loc
+  PatternAscription p td loc  -> PatternAscription (substPattern f p) td loc
+  PatternLit e (Info tp) loc  -> PatternLit e (Info $ f tp) loc
 
 toPolyBinding :: ValBind -> PolyBinding
 toPolyBinding (ValBind _ name retdecl (Info rettype) tparams params body _ loc) =
diff --git a/src/Futhark/Internalise/TypesValues.hs b/src/Futhark/Internalise/TypesValues.hs
--- a/src/Futhark/Internalise/TypesValues.hs
+++ b/src/Futhark/Internalise/TypesValues.hs
@@ -119,6 +119,7 @@
       ets <- internaliseElemType et
       return [I.arrayOf et' (Shape dims) $ internaliseUniqueness u | et' <- ets ]
     E.Arrow{} -> fail $ "internaliseTypeM: cannot handle function type: " ++ pretty orig_t
+    E.Enum{} -> return [I.Prim $ I.IntType I.Int8]
 
   where internaliseElemType E.ArrayPolyElem{} =
           fail "internaliseElemType: cannot handle type variable."
@@ -126,6 +127,8 @@
           return [I.Prim $ internalisePrimType bt]
         internaliseElemType (E.ArrayRecordElem elemts) =
           concat <$> mapM (internaliseRecordElem . snd) (E.sortFields elemts)
+        internaliseElemType (E.ArrayEnumElem _ _) =
+          return [I.Prim $ I.IntType I.Int8]
 
         internaliseRecordElem (E.RecordArrayElem et) =
           internaliseElemType et
diff --git a/src/Futhark/Optimise/MemoryBlockMerging/Liveness/FirstUse.hs b/src/Futhark/Optimise/MemoryBlockMerging/Liveness/FirstUse.hs
--- a/src/Futhark/Optimise/MemoryBlockMerging/Liveness/FirstUse.hs
+++ b/src/Futhark/Optimise/MemoryBlockMerging/Liveness/FirstUse.hs
@@ -175,7 +175,6 @@
 
 createsNewArrayBase :: Exp lore -> Bool
 createsNewArrayBase e = case e of
-  BasicOp Partition{} -> True
   BasicOp Replicate{} -> True
   BasicOp Iota{} -> True
   BasicOp Manifest{} -> True
diff --git a/src/Futhark/Optimise/Simplify/Engine.hs b/src/Futhark/Optimise/Simplify/Engine.hs
--- a/src/Futhark/Optimise/Simplify/Engine.hs
+++ b/src/Futhark/Optimise/Simplify/Engine.hs
@@ -40,7 +40,6 @@
        , isOp
        , isNotSafe
        , asksEngineEnv
-       , changed
        , askVtable
        , localVtable
 
@@ -167,8 +166,7 @@
   let (x, (src', b), _) = runRWS m (simpl, env) (src, False)
   in ((x, b), src')
 
-subSimpleM :: (MonadFreshNames m,
-               SameScope outerlore lore,
+subSimpleM :: (SameScope outerlore lore,
                ExpAttr outerlore ~ ExpAttr lore,
                BodyAttr outerlore ~ BodyAttr lore,
                RetType outerlore ~ RetType lore,
@@ -177,14 +175,15 @@
            -> Env lore
            -> ST.SymbolTable (Wise outerlore)
            -> SimpleM lore a
-           -> m (a, Bool)
+           -> SimpleM outerlore a
 subSimpleM simpl env outer_vtable m = do
   let inner_vtable = ST.castSymbolTable outer_vtable
   src <- getNameSource
   let SimpleM m' = localVtable (<>inner_vtable) m
       (x, (src', b), _) = runRWS m' (simpl, env) (src, False)
   putNameSource src'
-  return (x, b)
+  when b changed
+  return x
 
 askEngineEnv :: SimpleM lore (Env lore)
 askEngineEnv = snd <$> ask
@@ -680,7 +679,7 @@
               protectLoopHoisted ctx' val' (WhileLoop cond'))
   seq_blocker <- asksEngineEnv $ blockHoistSeq . envHoistBlockers
   ((loopstms, loopres), hoisted) <-
-    enterLoop $
+    enterLoop $ consumeMerge $
     bindFParams (ctxparams'++valparams') $ wrapbody $
     blockIf
     (hasFree boundnames `orIf` isConsumed
@@ -689,7 +688,12 @@
       return ((res, uses <> isDoLoopResult res), stms)
   loopbody' <- constructBody loopstms loopres
   return (DoLoop ctx' val' form' loopbody', hoisted)
-  where fparamnames = S.fromList (map (paramName . fst) $ ctx++val)
+  where fparamnames =
+          S.fromList (map (paramName . fst) $ ctx++val)
+        consumeMerge =
+          localVtable $ flip (foldl' (flip ST.consume)) consumed_by_merge
+        consumed_by_merge =
+          freeIn $ map snd $ filter (unique . paramDeclType . fst) val
 
 simplifyExp (Op op) = do (op', stms) <- simplifyOp op
                          return (Op op', stms)
diff --git a/src/Futhark/Optimise/Simplify/Rules.hs b/src/Futhark/Optimise/Simplify/Rules.hs
--- a/src/Futhark/Optimise/Simplify/Rules.hs
+++ b/src/Futhark/Optimise/Simplify/Rules.hs
@@ -355,8 +355,8 @@
 -- This simplistic rule is only valid before we introduce memory.
 removeUnnecessaryCopy :: BinderOps lore => BottomUpRuleBasicOp lore
 removeUnnecessaryCopy (vtable,used) (Pattern [] [d]) _ (Copy v)
-  | not (v `UT.used` used),
-    consumable || not (patElemName d `UT.isConsumed` used) =
+  | not (v `UT.isConsumed` used),
+    (not (v `UT.used` used) && consumable) || not (patElemName d `UT.isConsumed` used) =
       letBind_ (Pattern [] [d]) $ BasicOp $ SubExp $ Var v
   where -- We need to make sure we can even consume the original.
         -- This is currently a hacky check, much too conservative,
@@ -686,7 +686,7 @@
     Just (Copy src, cs)
       | Just dims <- arrayDims <$> seType (Var src),
         length inds == length dims,
-        not consuming ->
+        not consuming, ST.available src vtable ->
           Just $ pure $ IndexResult cs src inds
 
     Just (Reshape newshape src, cs)
@@ -1197,6 +1197,25 @@
       certifying (cs<>v_cs) $
         letBind_ pat $ BasicOp $ Rotate offsets v2
         where add x y = letSubExp "offset" $ BasicOp $ BinOp (Add Int32) x y
+
+-- If we see an Update with a scalar where the value to be written is
+-- the result of indexing some other array, then we convert it into an
+-- Update with a slice of that array.  This matters when the arrays
+-- are far away (on the GPU, say), because it avoids a copy of the
+-- scalar to and from the host.
+ruleBasicOp vtable pat (StmAux cs_x _) (Update arr_x slice_x (Var v))
+  | Just _ <- sliceIndices slice_x,
+    Just (Index arr_y slice_y, cs_y) <- ST.lookupBasicOp v vtable,
+    ST.available arr_y vtable,
+    -- XXX: we should check for proper aliasing here instead.
+    arr_y /= arr_x,
+    Just (slice_x_bef, DimFix i, []) <- focusNth (length slice_x - 1) slice_x,
+    Just (slice_y_bef, DimFix j, []) <- focusNth (length slice_y - 1) slice_y = do
+      let slice_x' = slice_x_bef ++ [DimSlice i (intConst Int32 1) (intConst Int32 1)]
+          slice_y' = slice_y_bef ++ [DimSlice j (intConst Int32 1) (intConst Int32 1)]
+      v' <- letExp (baseString v ++ "_slice") $ BasicOp $ Index arr_y slice_y'
+      certifying (cs_x <> cs_y) $
+        letBind_ pat $ BasicOp $ Update arr_x slice_x' $ Var v'
 
 ruleBasicOp _ _ _ _ =
   cannotSimplify
diff --git a/src/Futhark/Optimise/TileLoops.hs b/src/Futhark/Optimise/TileLoops.hs
--- a/src/Futhark/Optimise/TileLoops.hs
+++ b/src/Futhark/Optimise/TileLoops.hs
@@ -21,6 +21,7 @@
 import Futhark.Pass
 import Futhark.Tools
 import Futhark.Util (mapAccumLM)
+import Futhark.Optimise.TileLoops.RegTiling3D
 
 tileLoops :: Pass Kernels Kernels
 tileLoops = Pass "tile loops" "Tile stream loops inside kernels" $
@@ -36,19 +37,23 @@
 type TileM = ReaderT (Scope Kernels) (State VNameSource)
 
 optimiseBody :: Body Kernels -> TileM (Body Kernels)
-optimiseBody (Body () bnds res) =
+optimiseBody (Body () bnds res) = localScope (scopeOf bnds) $
   Body () <$> (mconcat <$> mapM optimiseStm (stmsToList bnds)) <*> pure res
 
 optimiseStm :: Stm Kernels -> TileM (Stms Kernels)
-optimiseStm (Let pat aux (Op old_kernel@(Kernel desc space ts body))) = do
-  (extra_bnds, space', body') <- tileInKernelBody mempty initial_variance space body
-  let new_kernel = Kernel desc space' ts body'
-  -- XXX: we should not change the type of the kernel (such as by
-  -- changing the number of groups being used for a kernel that
-  -- returns a result-per-group).
-  if kernelType old_kernel == kernelType new_kernel
-    then return $ extra_bnds <> oneStm (Let pat aux $ Op new_kernel)
-    else return $ oneStm $ Let pat aux $ Op old_kernel
+optimiseStm stmt@(Let pat aux (Op old_kernel@(Kernel desc space ts body))) = do
+  res3dtiling <- doRegTiling3D stmt
+  case res3dtiling of
+    Just (extra_bnds, stmt') -> return $ extra_bnds <> oneStm stmt'
+    Nothing -> do
+          (extra_bnds, space', body') <- tileInKernelBody mempty initial_variance space body
+          let new_kernel = Kernel desc space' ts body'
+          -- XXX: we should not change the type of the kernel (such as by
+          -- changing the number of groups being used for a kernel that
+          -- returns a result-per-group).
+          if kernelType old_kernel == kernelType new_kernel
+            then return $ extra_bnds <> oneStm (Let pat aux $ Op new_kernel)
+            else return $ oneStm $ Let pat aux $ Op old_kernel
   where initial_variance = M.map mempty $ scopeOfKernelSpace space
 optimiseStm (Let pat aux e) =
   pure <$> (Let pat aux <$> mapExpM optimise e)
diff --git a/src/Futhark/Optimise/TileLoops/RegTiling3D.hs b/src/Futhark/Optimise/TileLoops/RegTiling3D.hs
new file mode 100644
--- /dev/null
+++ b/src/Futhark/Optimise/TileLoops/RegTiling3D.hs
@@ -0,0 +1,739 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+-- | Perform a restricted form of register tiling corresponding to
+--   the following pattern:
+--     * a stream is perfectly nested inside a kernel with at least
+--       three parallel dimension (the perfectly nested restriction
+--       can be relaxed a bit);
+--     * all streamed arrays are one dimensional;
+--     * all streamed arrays are variant to exacly one of the three
+--       innermost parallel dimensions, and conversly for each of
+--       the three innermost parallel dimensions, there is at least
+--       one streamed array variant to it;
+--     * the stream's result is a tuple of scalar values, which are
+--       also the "thread-in-space" return of the kernel.
+--   Target code can be found in "tests/reg-tiling/reg-tiling-3d.fut".
+module Futhark.Optimise.TileLoops.RegTiling3D
+       ( doRegTiling3D )
+       where
+
+import Control.Monad.State
+import Control.Monad.Reader
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+import Data.List
+import Data.Semigroup ((<>))
+import Data.Maybe
+
+import Futhark.MonadFreshNames
+import Futhark.Representation.Kernels
+import Futhark.Tools
+import Futhark.Transform.Substitute
+import Futhark.Transform.Rename
+
+type TileM = ReaderT (Scope Kernels) (State VNameSource)
+type VarianceTable = M.Map VName Names
+
+maxRegTile :: Int32
+maxRegTile = 30
+
+mkRegTileSe :: Int32 -> SubExp
+mkRegTileSe = constant
+
+-- | Expects a kernel statement as argument.
+--   CONDITIONS for 3D tiling optimization to fire are:
+--     1. a) The kernel body can be broken into
+--              scalar-code-1 ++ [GroupStream stmt] ++ scalar-code-2.
+--        b) The kernels has a "ThreadsReturn ThreadsInSpace" result,
+--              and obviously the result is variant to the 3rd dimension
+--              (counter from innermost to outermost)
+--     2. For the GroupStream (morally StreamSeq):
+--          a) the arrays' outersize must equal the maximal chunk size
+--          b) the streamed arrays are one dimensional
+--          c) each of the array arguments of GroupStream are variant
+--              to exactly one of the three innermost-parallel dimension
+--              of the kernel. This condition can be relaxed by interchanging
+--              kernel dimensions whenever possible.
+--     3. For scalar-code-1:
+--          a) each of the statements is a slice that produces one of the
+--             streamed arrays
+--     4. For simplicity assume scalar-code-2 is empty!
+--        (To be extended later.)
+--   ASSUME the initial kernel is (as in tests/reg-tiling/reg-tiling-3d.fut):
+--
+--     kernel map(num groups: num_groups, group size: group_size,
+--                num threads: num_threads, global TID -> global_tid,
+--                local TID -> local_tid, group ID -> group_id)
+--                (gtid_z < size_z, gtid_y < size_xy,
+--                gtid_x < size_xy) : {f32} {
+--        let {[size_com]f32 flags} = <empty_or_match_cert_6685>fss_6664[gtid_z,
+--                                                                   0i32:+size_com*1i32]
+--        let {[size_com]f32 ass} = ass_6662[gtid_y, 0i32:+size_com*1i32]
+--        let {[size_com]f32 bss} = res_6687[gtid_x, 0i32:+size_com*1i32]
+--        let {f32 res_ker} =
+--         stream(size_com, size_com,
+--                fn (int chunk_size_out, int chunk_offset_6736, f32 acc_out,
+--                    [chunk_size_out]f32 flags_chunk_out,
+--                    [chunk_size_out]f32 ass_chunk_out,
+--                    [chunk_size_out]f32 bss_chunk_out) =>
+--                  let {f32 res_out} =
+--                    stream(chunk_size_out, 1i32,
+--                           fn (int chunk_size_in, int i_6743, f32 acc_in,
+--                               [chunk_size_in]f32 flags_chunk_in,
+--                               [chunk_size_in]f32 ass_chunk_in,
+--                               [chunk_size_in]f32 bss_chunk_in) =>
+--                             let {f32 f} = flags_chunk_in[0i32]
+--                             let {f32 a} = ass_chunk_in[0i32]
+--                             let {f32 b} = bss_chunk_in[0i32]
+--                             let {bool cond} = lt32(f, 9.0f32)
+--                             let {f32 tmp} =
+--                               if cond
+--                               then {
+--                                 let {f32 tmp1} = fmul32(a, b)
+--                                 in {tmp1}
+--                               } else {0.0f32}
+--                             let {f32 res_in} = fadd32(acc_in, tmp)
+--                             in {res_in},
+--                           {acc_out},
+--                           flags_chunk_out, ass_chunk_out, bss_chunk_out)
+--                  in {res_out},
+--                {0.0f32},
+--                flags, ass, bss)
+--        return {thread in space returns res_ker}
+--     }
+--
+doRegTiling3D :: Stm Kernels -> TileM (Maybe (Stms Kernels, Stm Kernels))
+doRegTiling3D (Let pat aux (Op old_kernel))
+  | Kernel kerhint space kertp (KernelBody () kstms kres) <- old_kernel,
+    FlatThreadSpace gspace <- spaceStructure space,
+    initial_variance <- M.map mempty $ scopeOfKernelSpace space,
+    variance <- varianceInStms initial_variance kstms,
+    local_tid <- spaceLocalId space,
+    (_,_) : (_,_) : (gidz,m_M) : _ <- reverse $ spaceDimensions space,
+    (code1, Just stream_stmt, code2) <- matchCodeStreamCode kstms,
+    Let pat_strm aux_strm (Op (GroupStream w w0 lam accs arrs)) <- stream_stmt,
+    not (null accs),
+    reg_tile <- maxRegTile `quot` fromIntegral (length accs),
+    reg_tile_se <- mkRegTileSe reg_tile,
+    w == w0,
+    arr_chunk_params <- groupStreamArrParams lam,
+    Just _ <- is3dTileable mempty space variance
+                           arrs arr_chunk_params,
+    Just arr_tab0 <- foldl (processIndirections $ S.fromList arrs)
+                           (Just M.empty) code1,
+    -- for simplicity, assume a single result, which is variant to
+    -- the outer parallel dimension (for sanity sake, it should be)
+    ker_res_nms <- mapMaybe retThreadInSpace kres,
+    length ker_res_nms == length kres,
+    Pattern [] ker_patels  <- pat,
+    all primType kertp,
+    all (variantToOuterDim variance gidz) ker_res_nms = do
+  mm <- newVName "mm"
+  mask <- newVName "mask"
+
+  -- let mm = gidz * regTile
+  let mm_stmt = mkInKerIntMulStmt mm (Var gidz) reg_tile_se
+  let mask_stm= mkLet [] [Ident mask $ Prim int32] $ BasicOp $
+                         BinOp (Shl Int32)
+                          (Constant $ IntValue $ Int32Value 1 )
+                          (Constant $ IntValue $ Int32Value 31)
+
+  -- process the z-variant arrays that need transposition;
+  -- these "manifest" statements should come before the kernel
+  (arr_tab,trnsp_tab) <- foldM (insertTranspose variance gidz)
+                                (M.empty, M.empty) $ M.toList arr_tab0
+  let manif_stms = map(\ (a_t, (a,i,tp)) ->
+                        let perm = [i+1..arrayRank tp-1] ++ [0..i]
+                        in  mkLet [] [Ident a_t tp] $
+                                  BasicOp $ Manifest perm a
+                      ) $ M.toList trnsp_tab
+
+  -- adjust the kernel space for 3d register tiling.
+  (space_stms, space_struct, tiled_group_size, num_threads, num_groups) <-
+        mkKerSpaceExtraStms reg_tile gspace
+  let kspace' = space { spaceStructure  = space_struct
+                      , spaceGroupSize  = tiled_group_size
+                      , spaceNumThreads = num_threads
+                      , spaceNumGroups  = num_groups
+                      }
+
+  -- most everything happans here!
+  mb_myloop <- translateStreamsToLoop (reg_tile,mask,gidz,m_M,mm,local_tid,tiled_group_size)
+                                      variance arr_tab w lam accs arrs $
+                                      patternValueElements pat_strm
+
+  -- ToDo: adjust the new kernel with
+  --       1. in-place update return: for this you will need to `scratch`
+  --          the result array before the kernel
+  --       2. adjust the range of gidz to `(m_M + TILE_REG -1)/ TILE_REG`
+  --       3. transpose the array invariant to the third-inner dim
+  case mb_myloop of
+    Nothing -> return Nothing
+    Just (myloop, strm_res_inv, strm_res_var) -> do
+      -- make loop statement
+      loop_var_res <- forM strm_res_var $ \(PatElem nm attr) -> do
+        clone_patel_nms <- replicateM (fromIntegral reg_tile) $ newVName $ baseString nm
+        return $ map (`PatElem` attr) clone_patel_nms
+      let pat_loop = Pattern [] $ strm_res_inv ++ concat loop_var_res
+      let stm_loop = Let pat_loop aux_strm myloop
+
+      -- get variant ker-results and corresponding pattern elements
+      let ker_var_res_patels =
+            filter (\(r,_) -> variantToOuterDim variance gidz r) $
+                   zip ker_res_nms ker_patels
+          (ker_var_res, ker_var_patels) = unzip ker_var_res_patels
+          (code2_var, code2_inv) =
+            partition (variantToOuterDim variance gidz . patElemName .
+                       head . patternValueElements . stmPattern) code2
+
+      -- make the scratch statements for kernel results variant to the z-parallel dimension
+      scratch_nms_stms <- mapM mkScratchStm ker_var_patels
+      let (scratch_nms, scratch_stms) = unzip scratch_nms_stms
+          loop_var_nms_tr = transpose $ map (map patElemName) loop_var_res
+
+      -- clone the statements in code2 variant to the z-parallel dimension,
+      -- by encapsulating them inside if-then-else in which the then-body
+      -- terminates with an in-place update corresponding to the result!
+          strm_var_nms = map patElemName strm_res_var
+      (ip_out_nms, unrolled_code) <-
+          foldM (cloneVarCode2 mm space strm_var_nms ker_var_res_patels code2_var)
+                (scratch_nms, []) $ zip [0..reg_tile-1] loop_var_nms_tr
+
+      -- replace the `ThreadsInSpace` kernel return to an `InPlace` return
+      -- for the z-variant kernel results
+      let ker_res_ip_tp_tab = M.fromList $ zip ker_var_res $ zip ip_out_nms $
+                                           map patElemType ker_var_patels
+          (kres', kertp') = unzip $
+            zipWith (\ r tp -> case M.lookup r ker_res_ip_tp_tab of
+                                 Nothing -> (ThreadsReturn ThreadsInSpace (Var r), tp)
+                                 Just (ip_nm, ip_tp) -> (KernelInPlaceReturn ip_nm, ip_tp)
+                    ) ker_res_nms kertp
+
+      -- finally, put everything together
+          kstms' = stmsFromList $ mask_stm : mm_stmt : stm_loop : (code2_inv ++ unrolled_code)
+          ker_body = KernelBody () kstms' kres'
+          new_ker = Op $ Kernel kerhint kspace' kertp' ker_body
+          extra_stms = space_stms <> stmsFromList (scratch_stms ++ manif_stms)
+      return $ Just (extra_stms, Let pat aux new_ker)
+
+  where -- | Checks that the statement is a slice that produces one of the
+        --   streamed arrays. Also that the streamed array is one dimensional.
+        --   Accumulates the information in a table for later use.
+        processIndirections :: S.Set VName
+                            -> Maybe (M.Map VName (VName, Slice SubExp, Type))
+                            -> Stm InKernel
+                            -> Maybe (M.Map VName (VName, Slice SubExp, Type))
+        processIndirections arrs acc (Let patt _ (BasicOp (Index arr_nm slc))) =
+          case (acc, patternValueElements patt) of
+              (Nothing,    _) -> Nothing
+              (Just tab, [p]) -> do
+                  let (p_nm, p_tp) = (patElemName p, patElemType p)
+                  case (S.member p_nm arrs, p_tp) of
+                    (True, Array _ (Shape [_]) _) ->
+                      Just $ M.insert p_nm (arr_nm,slc,p_tp) tab
+                    _ -> Nothing
+              (_, _) -> Nothing
+        processIndirections _ _ _ = Nothing
+
+        -- |   The second Map accumulator keeps tracks of the arrays that
+        --       are variant to the z-parallel dimension and need to be transposed;
+        --       the `Int` field refers to the index of the z-variant dimension, and
+        --       the `Type` field refers to the type of the original global array.
+        --     The first accumulator table is updated to refer to the transposed-array
+        --       name, whenever such a case is discovered; otherwise it just accumulates.
+        insertTranspose :: VarianceTable -> VName
+                        -> (M.Map VName (VName, Slice SubExp, Type), M.Map VName (VName,Int,Type))
+                        -> (VName, (VName, Slice SubExp, Type))
+                        -> TileM (M.Map VName (VName, Slice SubExp, Type), M.Map VName (VName,Int,Type))
+        insertTranspose variance gidz (tab, trnsp) (p_nm, (arr_nm,slc,p_tp)) =
+          case findIndex (variantSliceDim variance gidz) slc of
+            Nothing -> return (M.insert p_nm (arr_nm,slc,p_tp) tab, trnsp)
+            Just  i -> do
+              arr_tp <- lookupType arr_nm
+              arr_tr_nm <- newVName $ baseString arr_nm ++ "_transp"
+              let tab'   = M.insert p_nm (arr_tr_nm,slc,p_tp) tab
+              let trnsp' = M.insert arr_tr_nm (arr_nm, i, arr_tp) trnsp
+              return (tab', trnsp')
+
+        variantSliceDim :: VarianceTable -> VName -> DimIndex SubExp -> Bool
+        variantSliceDim variance gidz (DimFix (Var vnm)) = variantToOuterDim variance gidz vnm
+        variantSliceDim _ _ _ = False
+
+        mkInKerIntMulStmt :: VName -> SubExp -> SubExp -> Stm InKernel
+        mkInKerIntMulStmt res_nm0 op1_se op2_se =
+            mkLet [] [Ident res_nm0 $ Prim int32] $
+              BasicOp $ BinOp (Mul Int32) op1_se op2_se
+
+        retThreadInSpace (ThreadsReturn ThreadsInSpace (Var r)) = Just r
+        retThreadInSpace _ = Nothing
+
+doRegTiling3D _ = return Nothing
+
+translateStreamsToLoop :: (Int32,VName,VName,SubExp,VName,VName,SubExp) ->
+                          VarianceTable ->
+                          M.Map VName (VName, Slice SubExp, Type) ->
+                          SubExp -> GroupStreamLambda InKernel ->
+                          [SubExp] -> [VName] -> [PatElem InKernel]
+                       -> TileM (Maybe (Exp InKernel, [PatElem InKernel], [PatElem InKernel]))
+translateStreamsToLoop (reg_tile, mask,gidz,m_M,mm,local_tid, group_size) variance
+                       arr_tab w_o lam_o accs_o_p arrs_o_p strm_ress
+  | -- 1. We assume the inner stream (of chunk 1) is directly nested
+    --    inside the outer stream and also takes its arguments (array
+    --    and accumulators) from the outer stream (all checked).
+    --    Also all accumulators have primitive types (otherwise
+    --    they cannot be efficiently stored in registers anyway).
+    accs_o_f <- groupStreamAccParams lam_o,
+    arrs_o_f <- groupStreamArrParams lam_o,
+    [Let _ _ (Op (GroupStream _ ct1i32 lam_i accs_i_p arrs_i_p))] <-
+        stmsToList $ bodyStms $ groupStreamLambdaBody lam_o,
+    ct1i32 == (Constant $ IntValue $ Int32Value 1),
+    accs_i_f <- groupStreamAccParams lam_i,
+    arrs_i_f <- groupStreamArrParams lam_i,
+    and $ zipWith (==) (map subExpVar accs_i_p) (map (Just . paramName) accs_o_f),
+    and $ zipWith (==) arrs_i_p $ map paramName arrs_o_f,
+    all (primType . paramType) accs_o_f,
+    -- 2. The intent is to flatten the two streams into a loop, so
+    --    we reuse the index of the inner stream for the result-loop index,
+    --    and we will modify the body of the inner lambda `body_i` for the
+    --    result loop.
+    loop_ind_nm <- groupStreamChunkOffset lam_i,
+    body_i <- groupStreamLambdaBody lam_i,
+    -- 3. We transfer the slicing information (from sclar-code-1) to
+    --    the array-formal arguments of the inner stream.
+    arr_tab' <- foldl (\ tab (a_o_p, a_o_f, a_i_p, a_i_f) ->
+                        case (paramName a_o_f == a_i_p, M.lookup a_o_p tab) of
+                          (True, Just info) -> M.insert (paramName a_i_f) info tab
+                          _ -> tab
+                      ) arr_tab $ zip4 arrs_o_p arrs_o_f arrs_i_p arrs_i_f,
+    -- 4. We translate the inner stream's accumulator to a FParam, required for
+    --    mapping it as a result-loop variant variable.
+    accs_i_f' <- map translParamToFParam accs_i_f,
+    -- 5. We break the "loop" statements into two parts:
+    --      a) the ones invariant to the z parallel dimension `invar_out_stms`,
+    --      b) the ones variant   to the z parallel dimension `var_out_stms`, and
+    --      c) the ones corresponding to indexing operations on variant arrays `var_ind_stms`.
+    (invar_out_stms, var_ind_stms, var_out_stms) <-
+      foldl (\ (acc_inv, acc_inds, acc_var) stmt ->
+                let nm = patElemName $ head $ patternValueElements $ stmPattern stmt
+                in  if not $ variantToOuterDim variance gidz nm
+                    then (stmt : acc_inv,acc_inds,acc_var)
+                    else case stmt of
+                           Let _ _ (BasicOp (Index arr_nm [DimFix _])) ->
+                             case M.lookup arr_nm arr_tab' of
+                                Just _  -> (acc_inv,stmt:acc_inds,acc_var)
+                                Nothing -> (acc_inv,acc_inds,stmt:acc_var)
+                           _ -> (acc_inv,acc_inds,stmt:acc_var)
+            ) ([],[],[]) $ reverse $ stmsToList $ bodyStms body_i,
+    -- 6. We check that the variables used in the index statements referring to
+    --    streamed arrays that are variant to the z parallel dimension (`var_ind_stms`)
+    --    depend only on variables defined in the invariant stms to the z parallel dimension.
+    var_nms <- concatMap (patternNames . stmPattern) var_out_stms,
+    null $ S.intersection (S.fromList var_nms) $
+                          S.unions (map freeInStm var_ind_stms),
+    -- 7. We assume (check) for simplicity that all accumulator initializers
+    --     of the outer stream are invariant to the z parallel dimension.
+    loop_ini_vs <- subExpVars accs_o_p,
+    all (not . variantToOuterDim variance gidz) loop_ini_vs,
+    -- 8. We assume that all results of the inner-stream body are variables
+    --    (for simplicity); they should have been simplified anyways if not!
+    loop_res0 <- bodyResult body_i,
+    loop_res  <- subExpVars loop_res0,
+    length loop_res == length loop_res0 = do
+  -- I. After all these conditions, we finally start by partitioning
+  --    the stream's accumulators and results into the ones that are
+  --    variant to the z-parallel dimension and the ones that are not.
+  let (loop_var_p_i_r, loop_inv_p_i_r) =
+        partition (\(_,_,r,_) -> variantToOuterDim variance gidz r) $
+                  zip4 accs_i_f' accs_o_p loop_res strm_ress
+  -- II. Transform the statements invariant to the z-parallel dimension
+  --     so that they perform indexing in the global arrays rather than
+  --     in the streamed arrays, i.e., eliminate the indirection.
+  inv_stms0 <- mapM (transfInvIndStm arr_tab' loop_ind_nm) invar_out_stms
+  let inv_stms = concat inv_stms0
+  -- III. the index-statements variant to the z-parallel dimension are
+  --      transformed to combined regions.
+  m <- newVName "m"
+  ind_stms0 <- foldM (transfVarIndStm arr_tab' (reg_tile,loop_ind_nm,local_tid,group_size,m,m_M))
+                      (Just ([],M.empty)) $ reverse var_ind_stms
+  case ind_stms0 of
+    Nothing -> return Nothing
+    Just (ind_stms, subst_tab) -> do
+      -- IV. Add statement `let m = mm + local_tid`
+      --     Then perform the substitution `gidz -> m` on the combine regions.
+      let m_stmt = mkLet [] [Ident m $ Prim int32] $
+                BasicOp $ BinOp (Add Int32) (Var mm) (Var local_tid)
+          tab_z_m_comb = M.insert gidz m M.empty
+          ind_stms' = m_stmt : map (substituteNames tab_z_m_comb) ind_stms
+
+      -- V. We clone the variant statements regTile times and enclose
+      --    each one in a if-then-else testing whether `mm + local_id < m_M`
+      --    TODO: check that the statements do not involve In-Place updates!
+      let loop_var_p_i_r' = map (\(x,y,z,_)->(x,y,z)) loop_var_p_i_r
+      if_ress <- mapM (cloneVarStms subst_tab (mask,loop_ind_nm,mm,m_M,gidz)
+                                     loop_var_p_i_r' var_out_stms) [0..reg_tile-1]
+      -- VI. build the loop-variant vars/res/inis
+      let (if_stmt_clones0, var_ress_pars) = unzip if_ress
+          if_stmt_clones = concat if_stmt_clones0
+          (_, var_ini, _, strm_var_res) = unzip4 loop_var_p_i_r
+          var_inis = concat $ replicate (fromIntegral reg_tile) var_ini
+          (var_ress, var_pars) = unzip $ concat var_ress_pars
+          (inv_pars, inv_inis, inv_ress, strm_inv_res) = unzip4 loop_inv_p_i_r
+          loop_form_acc = inv_pars ++ var_pars
+          loop_inis_acc = inv_inis ++ var_inis
+          loop_ress     = inv_ress ++ var_ress
+      -- VII. Finally build the loop body and return it!
+      --      Insert an extra barrier at the begining of the loop; make
+      --        it dependent on the loop index so it cannot be hoisted!
+      ind_bar <- newVName "loop_ind"
+      let bar_stmt = mkLet [] [Ident loop_ind_nm $ Prim int32] $ Op (Barrier [Var ind_bar])
+          stms_body_i' = bar_stmt : inv_stms ++ ind_stms' ++ if_stmt_clones
+          form = ForLoop ind_bar Int32 w_o []
+          body_i' = Body (bodyAttr body_i)
+                         (stmsFromList stms_body_i') $
+                         map Var loop_ress
+          myloop = DoLoop [] (zip loop_form_acc loop_inis_acc) form body_i'
+          free_in_body = freeInBody body_i'
+          elim_vars = S.fromList $ arrs_i_p ++ arrs_o_p ++
+                                   map paramName arrs_i_f ++
+                                   map paramName accs_o_f
+      if null $ S.intersection free_in_body elim_vars
+      then return $ Just (myloop, strm_inv_res, strm_var_res)
+      else return Nothing
+translateStreamsToLoop _ _ _ _ _ _ _ _ = return Nothing
+
+-- | Clone the variant statements, by creating a new if-then-else
+--   big statement that cheks that `mm + i < m_M` for `i = 0...regTile-1`
+--   Return the if-then-else statement together with the result variables
+--   so that the body of the loop and the loop results and paramters can
+--   be constructed.
+--   In order to disallow hoisting from the loop we will generate:
+--   let zero = mask & loop_ind
+--   let mmpi = zero + mm + i
+cloneVarStms :: M.Map VName (VName,Type) -> (VName, VName, VName, SubExp, VName)
+              -> [(FParam InKernel, SubExp, VName)] -> [Stm InKernel]
+              -> Int32 -> TileM ([Stm InKernel], [(VName,FParam InKernel)])
+cloneVarStms subst_tab (mask,loop_ind,mm,m_M,gidz) loop_info var_out_stms i = do
+  let (loop_par_origs, loop_inis, body_res_origs) = unzip3 loop_info
+  body_res_clones <- mapM (\x -> newVName $ baseString x ++ "_clone") body_res_origs
+  loop_par_nm_clones <- mapM (\x -> newVName $ baseString (paramName x) ++ "_clone") loop_par_origs
+  m <- newVName "m"
+  z <- newVName "zero"
+  ii<- newVName "unroll_ct"
+  let loop_par_clones = zipWith (\ p nm -> p { paramName = nm })
+                                loop_par_origs loop_par_nm_clones
+      res_types = map paramType loop_par_origs
+      i_se = Constant $ IntValue $ Int32Value i
+
+      stmt_zero = mkLet [] [Ident z  $ Prim int32] $
+                        BasicOp $ BinOp (And Int32) (Var mask) (Var loop_ind)
+      stmt_ii   = mkLet [] [Ident ii $ Prim int32] $
+                        BasicOp $ BinOp (Add Int32) (Var z) i_se
+      m_stmt_other =
+        mkLet [] [Ident m $ Prim int32] $
+              BasicOp $ BinOp (Add Int32) (Var mm) (Var ii)
+      read_sh_stms =
+        map (\ (scal,(sh_arr, el_tp)) ->
+                  mkLet [] [Ident scal el_tp] $
+                        BasicOp $ Index sh_arr [DimFix i_se]
+            ) $ M.toList subst_tab
+      tab_z_m_other = foldl (\tab (old,new) -> M.insert (paramName old) new tab)
+                            (M.insert gidz m M.empty) $
+                            zip loop_par_origs loop_par_nm_clones
+      var_out_stms' = map (substituteNames tab_z_m_other) $
+                           read_sh_stms ++ var_out_stms
+  cond_nm <- newVName "out3_inbounds"
+  -- if the statements are simple, i.e., "safe", then do not
+  -- encapsulate them in an if-then-else; this will result in
+  -- significant performance gains.
+  let simple = all simpleStm var_out_stms
+  let cond_stm  = if simple
+                  then mkLet [] [Ident cond_nm $ Prim Bool] $
+                          BasicOp $ SubExp (Constant $ BoolValue True)
+                  else mkCondStmt m_M m cond_nm
+      -- TODO: we need to uniquely rename the then/else bodies!
+  then_body <- renameBody $ Body () (stmsFromList var_out_stms') (map Var body_res_origs)
+  let else_body = Body () mempty loop_inis
+      if_stmt = mkLet [] (zipWith Ident body_res_clones res_types) $
+                  If (Var cond_nm) then_body else_body $
+                     IfAttr (staticShapes res_types) IfFallback
+  -- we will substitute later the original loop formal-param names
+  -- with the newly created ones in the body
+  return ( [stmt_zero, stmt_ii, m_stmt_other, cond_stm, if_stmt]
+         , zip body_res_clones loop_par_clones )
+
+mkCondStmt :: SubExp -> VName -> VName -> Stm InKernel
+mkCondStmt m_M m cond_nm =
+  mkLet [] [Ident cond_nm $ Prim Bool] $
+        BasicOp $ CmpOp (CmpSlt Int32) (Var m) m_M
+
+simpleStm :: Stm InKernel -> Bool
+simpleStm (Let _ _ e) = safeExp e
+
+mkScratchStm :: PatElem Kernels -> TileM (VName, Stm Kernels)
+mkScratchStm ker_patel = do
+  let (unique_arr_tp, res_arr_nm0) = (patElemType ker_patel, patElemName ker_patel)
+      ptp = elemType unique_arr_tp
+  scrtch_arr_nm <- newVName $ baseString res_arr_nm0 ++ "_0"
+  let scratch_stm = mkLet [] [Ident scrtch_arr_nm unique_arr_tp] $
+                          BasicOp $ Scratch ptp $ arrayDims unique_arr_tp
+  return (scrtch_arr_nm, scratch_stm)
+
+-- | Arguments are:
+--     1. @mm@ this is the length of z-parallel dimension divided by reg_tile
+--     2. @space@: the kernel space
+--     3. @strm_res_nms@: the z-variant results of the original stream
+--     4. @keres_patels@: the kernel result names tupled with the corresponding
+--                        pattern elements of the kernel statement.
+--     5. @code2_var@: the z-variant statements of the code after the stream.
+--     6. @ip_arr_nms@: the "current" new names for the in-place update arrays.
+--        @unroll_code@: the current unrolled code. Both form a `foldM` accumulator.
+--     7. @k@ the "current" clone number;
+--        @loop_res_nms@ the names of the loop result corresponding to the current clone.
+--   Result:
+--     1. the new name for the current in-place update result,
+--     2. a new if-statement is added to the unrolled-code accumulator which actually
+--        perform the in-place update.
+cloneVarCode2 :: VName -> KernelSpace -> [VName]
+              -> [(VName, PatElem InKernel)] -> [Stm InKernel]
+              -> ([VName], [Stm InKernel]) -> (Int32, [VName])
+              -> TileM ([VName], [Stm InKernel])
+cloneVarCode2 mm space strm_res_nms keres_patels code2_var
+              (ip_arr_nms, unroll_code) (k, loop_res_nms) = do
+  let (ker_nms, pat_els) = unzip keres_patels
+      arr_tps = map patElemType pat_els
+      root_strs = map (baseString . patElemName) pat_els
+  ip_inn_nms <- mapM (\s -> newVName $ s ++ "_inn_" ++ pretty (k+1)) root_strs
+  ip_out_nms <- mapM (\s -> newVName $ s ++ "_out_" ++ pretty (k+1)) root_strs
+  m <- newVName "m"
+  -- make in-place update statements
+  let (gidx,_) : (gidy,_) : (gidz,m_M) : rev_outer_dims = reverse $ spaceDimensions space
+      (outer_dims, _) = unzip $ reverse rev_outer_dims
+      ip_stmts = map (mkInPlaceStmt (outer_dims++[m,gidy,gidx])) $
+                     zip4 ip_arr_nms ip_inn_nms ker_nms arr_tps
+  -- make if
+  cond_nm <- newVName "m_cond"
+  let i_se = Constant $ IntValue $ Int32Value k
+      m_stm = mkLet [] [Ident m $ Prim int32] $
+                    BasicOp $ BinOp (Add Int32) (Var mm) i_se
+      c_stm = mkCondStmt m_M m cond_nm
+      else_body = Body () mempty (map Var ip_arr_nms)
+      strm_loop_tab = M.fromList $ (gidz, m) : zip strm_res_nms loop_res_nms
+      then_stms = stmsFromList $ map (substituteNames strm_loop_tab) $
+                                     code2_var ++ ip_stmts
+  then_body <- renameBody $ Body () then_stms $ map Var ip_inn_nms
+  let if_stm = mkLet [] (zipWith Ident ip_out_nms arr_tps) $
+                     If (Var cond_nm) then_body else_body  $
+                     IfAttr (staticShapes arr_tps) IfFallback
+  return (ip_out_nms, unroll_code ++ [m_stm, c_stm, if_stm])
+  where mkInPlaceStmt :: [VName] -> (VName, VName, VName, Type)
+                      -> Stm InKernel
+        mkInPlaceStmt inds (cur_nm, new_nm, ker_nm, arr_tp) =
+          let upd_slc = map (DimFix . Var) inds
+              ipupd_exp = BasicOp $ Update cur_nm upd_slc (Var ker_nm)
+          in  mkLet [] [Ident new_nm arr_tp] ipupd_exp
+
+helper3Stms :: VName -> SubExp -> SubExp -> Slice SubExp
+             -> VName -> Stm InKernel -> TileM [Stm InKernel]
+helper3Stms loop_ind strd beg par_slc par_arr (Let ptt att _) = do
+  tmp1 <- newVName "tmp"
+  tmp2 <- newVName "ind"
+  let stmt1 = mkLet [] [Ident tmp1 $ Prim int32] $
+                BasicOp $ BinOp (Mul Int32) (Var loop_ind) strd
+      stmt2 = mkLet [] [Ident tmp2 $ Prim int32] $
+                BasicOp $ BinOp (Add Int32) beg (Var tmp1)
+      ndims = length par_slc
+      ind_exp = BasicOp (Index par_arr (take (ndims-1) par_slc ++ [DimFix $ Var tmp2]))
+      stmt3 = Let ptt att ind_exp
+  return [stmt1,stmt2,stmt3]
+
+-- | Insert the necessary translations for a statement that is indexing
+--   in one of the streamed arrays, which is invariant to the z-parallel
+--   dimension. The index is necessarily `0` at this point, and we use `tab`
+--   to figure out to what global array does the streamed array actually
+--   refers to, and to compute the global index.
+transfInvIndStm :: M.Map VName (VName, Slice SubExp, Type)
+                -> VName -> Stm InKernel
+                -> TileM [Stm InKernel]
+transfInvIndStm tab loop_ind stm@(Let _ _ (BasicOp (Index arr_nm [DimFix _])))
+  | Just (par_arr, par_slc@(_:_), _) <- M.lookup arr_nm tab,
+    DimSlice beg _ strd <- last par_slc =
+  helper3Stms loop_ind strd beg par_slc par_arr stm
+transfInvIndStm _ _ stm = return [stm]
+
+-- | Insert the necessary translations for a statement that is indexing
+--   inside one of the streamed arrays, which is variant to the outermost
+--   parallel dimension.
+transfVarIndStm :: M.Map VName (VName, Slice SubExp, Type)
+                -> (Int32,VName,VName,SubExp,VName,SubExp)
+                -> Maybe ([Stm InKernel],M.Map VName (VName,Type))
+                -> Stm InKernel
+                -> TileM (Maybe ([Stm InKernel],M.Map VName (VName,Type)))
+transfVarIndStm tab (reg_tile,loop_ind,local_tid,group_size,m,m_M) acc
+                    stm@(Let ptt _ (BasicOp (Index arr_nm [DimFix _])))
+  | Just (tstms,stab) <- acc,
+    Just (par_arr, par_slc@(_:_), _) <- M.lookup arr_nm tab,
+    DimSlice beg _ strd <- last par_slc,
+    [pat_el] <- patternValueElements ptt,
+    el_tp <- patElemType pat_el,
+    pat_el_nm <- patElemName pat_el,
+    Prim _ <- el_tp = do
+  -- compute the index into the global array
+  stms3 <- helper3Stms loop_ind strd beg par_slc par_arr stm
+  let glb_ind_stms = stmsFromList stms3
+  -- set up the combine part
+  sh_arr_1d <- newVName $ baseString par_arr ++ "_sh_1d"
+  cid <- newVName "cid"
+  let block_cspace = combineSpace [(cid,group_size)]
+      comb_exp = Op $ Combine block_cspace [el_tp]
+                    [(local_tid, mkRegTileSe reg_tile), (m,m_M)] $
+                    Body () glb_ind_stms [Var pat_el_nm]
+      sh_arr_pe = PatElem sh_arr_1d $
+                    arrayOfShape el_tp $ Shape [group_size]
+      write_sh_arr_stmt =
+         Let (Pattern [] [sh_arr_pe]) (defAux ()) comb_exp
+  return $ Just (write_sh_arr_stmt:tstms, M.insert pat_el_nm (sh_arr_1d,el_tp) stab)
+transfVarIndStm _ _ _ _ = return Nothing
+
+--------------
+--- HELPES ---
+--------------
+
+-- | translates an LParam to an FParam
+translParamToFParam :: LParam InKernel -> FParam InKernel
+translParamToFParam = fmap (`toDecl` Nonunique)
+
+-- | Tries to identified the following pattern:
+--   code folowed by a group stream followed by
+--   another code.
+matchCodeStreamCode :: Stms InKernel ->
+                       ([Stm InKernel], Maybe (Stm InKernel), [Stm InKernel])
+matchCodeStreamCode kstms =
+  foldl (\acc stmt ->
+            case (acc,stmt) of
+                ( (cd1,Nothing,cd2), Let _ _ (Op GroupStream{})) ->
+                    (cd1, Just stmt, cd2)
+                ( (cd1, Nothing, cd2), _) -> (cd1++[stmt], Nothing, cd2)
+                ( (cd1,Just strm,cd2), _) -> (cd1,Just strm,cd2++[stmt])
+        ) ([],Nothing,[]) (stmsToList kstms)
+
+-- | Checks that all streamed arrays are variant to exacly one of
+--   the three innermost parallel dimensions, and conversly for
+--   each of the three innermost parallel dimensions, there is at
+--   least one streamed array variant to it. The result is the
+--   the number of the only variant parallel dimension for each array.
+is3dTileable :: Names -> KernelSpace -> VarianceTable -> [VName]
+             -> [LParam InKernel] -> Maybe [Int]
+is3dTileable branch_variant kspace variance arrs block_params =
+  let ok1 = all (primType . rowType . paramType) block_params
+      inner_perm0 = map variantOnlyToOneOfThreeInnerDims arrs
+      inner_perm = catMaybes inner_perm0
+      ok2 = elem 0 inner_perm && elem 1 inner_perm && elem 2 inner_perm
+      ok3 = length inner_perm0 == length inner_perm
+      ok = ok1 && ok2 && ok3
+  in if ok then Just inner_perm else Nothing
+  where variantOnlyToOneOfThreeInnerDims :: VName -> Maybe Int
+        variantOnlyToOneOfThreeInnerDims arr = do
+          (k,_) : (j,_) : (i,_) : _ <- Just $ reverse $ spaceDimensions kspace
+          let variant_to = M.findWithDefault mempty arr variance
+              branch_invariant = not $  S.member k branch_variant ||
+                                        S.member j branch_variant ||
+                                        S.member i branch_variant
+          if not branch_invariant
+          then Nothing
+          else if      i `S.member` variant_to && not (j `S.member` variant_to) && not (k `S.member` variant_to) then Just 0
+               else if not (i `S.member` variant_to) && j `S.member` variant_to && not (k `S.member` variant_to) then Just 1
+               else if not (i `S.member` variant_to) && not (j `S.member` variant_to) && k `S.member` variant_to then Just 2
+               else Nothing
+
+mkKerSpaceExtraStms :: Int32 -> [(VName, SubExp)]
+                    -> TileM (Stms Kernels, SpaceStructure, SubExp, SubExp, SubExp)
+mkKerSpaceExtraStms reg_tile gspace = do
+  dim_z_nm <- newVName "gidz_range"
+  tmp <- newVName "tmp"
+  let tmp_stm = mkLet [] [Ident tmp $ Prim int32] $
+                      BasicOp $ BinOp (Add Int32) m_M $
+                      Constant $ IntValue $ Int32Value (reg_tile-1)
+      rgz_stm = mkLet [] [Ident dim_z_nm $ Prim int32] $
+                      BasicOp $ BinOp (SQuot Int32) (Var tmp) $
+                      Constant $ IntValue $ Int32Value reg_tile
+      (gidx,sz_x) : (gidy,sz_y) : (gidz,m_M) : untiled_gspace = reverse gspace
+
+  ((tile_size_x, tile_size_y, tiled_group_size), tile_size_bnds) <- runBinder $ do
+      tile_size_key <- newVName "tile_size"
+      tile_ct_size  <- letSubExp "tile_size" $ Op $ GetSize tile_size_key SizeTile
+      tile_size_x   <- letSubExp "tile_size_x" $ BasicOp $
+                                 BinOp (SMin Int32) tile_ct_size sz_x
+      tile_size_y   <- letSubExp "tile_size_y" $ BasicOp $
+                                 BinOp (SMin Int32) tile_ct_size sz_y
+      tiled_group_size <- letSubExp "tiled_group_size" $
+                                 BasicOp $ BinOp (Mul Int32) tile_size_x tile_size_y
+      return (tile_size_x, tile_size_y, tiled_group_size)
+      -- Play with reversion to ensure we get increasing IDs for
+      -- ltids.  This affects readability of generated code.
+  untiled_gspace' <- fmap reverse $ forM (reverse untiled_gspace) $ \(gtid,gdim) -> do
+      ltid <- newVName "ltid"
+      return (gtid, gdim, ltid, constant (1::Int32))
+  ltidz <- newVName "ltid"
+  let dim_z = (gidz, Var dim_z_nm, ltidz, constant (1::Int32))
+  ltidy <- newVName "ltid"
+  let dim_y = (gidy, sz_y, ltidy, tile_size_y)
+  ltidx <- newVName "ltid"
+  let dim_x = (gidx, sz_x, ltidx, tile_size_x)
+      gspace' = reverse $ dim_x : dim_y : dim_z : untiled_gspace'
+  -- We have to recalculate number of workgroups and
+  -- number of threads to fit the new workgroup size.
+  ((num_threads, num_groups), num_bnds) <-
+        runBinder $ sufficientGroups gspace' tiled_group_size
+
+  let extra_stms = oneStm tmp_stm <> oneStm rgz_stm <> tile_size_bnds <> num_bnds
+  return ( extra_stms, NestedThreadSpace gspace'
+         , tiled_group_size, num_threads, num_groups )
+
+
+variantToOuterDim :: VarianceTable -> VName -> VName -> Bool
+variantToOuterDim variance gid_outer nm =
+  gid_outer == nm || gid_outer `S.member` M.findWithDefault mempty nm variance
+
+varianceInStms :: VarianceTable -> Stms InKernel -> VarianceTable
+varianceInStms = foldl varianceInStm
+
+varianceInStm :: VarianceTable -> Stm InKernel -> VarianceTable
+varianceInStm v0 bnd@(Let _ _ (Op (GroupStream _ _ lam accs arrs))) =
+  let v = defVarianceInStm v0 bnd
+      acc_lam_f = groupStreamAccParams lam
+      arr_lam_f = groupStreamArrParams lam
+      bdy_lam   = groupStreamLambdaBody lam
+      stm_lam   = bodyStms   bdy_lam
+
+      v' = foldl' (\vacc (v_a, v_f) ->
+                    let vrc = S.insert v_a $ M.findWithDefault mempty v_a vacc
+                    in  M.insert v_f vrc vacc
+                  ) v $ zip arrs $ map paramName arr_lam_f
+      v''= foldl' (\vacc (v_se, v_f) ->
+                    case v_se of
+                      Var v_a ->
+                        let vrc = S.insert v_a $ M.findWithDefault mempty v_a vacc
+                        in  M.insert v_f vrc vacc
+                      Constant _ -> vacc
+                  ) v' $ zip accs $ map paramName acc_lam_f
+  in varianceInStms v'' stm_lam
+varianceInStm variance bnd = defVarianceInStm variance bnd
+
+defVarianceInStm :: VarianceTable -> Stm InKernel -> VarianceTable
+defVarianceInStm variance bnd =
+  foldl' add variance $ patternNames $ stmPattern bnd
+  where add variance' v = M.insert v binding_variance variance'
+        look variance' v = S.insert v $ M.findWithDefault mempty v variance'
+        binding_variance = mconcat $ map (look variance) $ S.toList (freeInStm bnd)
+
+sufficientGroups :: MonadBinder m =>
+                    [(VName, SubExp, VName, SubExp)] -> SubExp
+                 -> m (SubExp, SubExp)
+sufficientGroups gspace group_size = do
+  groups_in_dims <- forM gspace $ \(_, gd, _, ld) ->
+    letSubExp "groups_in_dim" =<< eDivRoundingUp Int32 (eSubExp gd) (eSubExp ld)
+  num_groups <- letSubExp "num_groups" =<<
+                foldBinOp (Mul Int32) (constant (1::Int32)) groups_in_dims
+  num_threads <- letSubExp "num_threads" $
+                 BasicOp $ BinOp (Mul Int32) num_groups group_size
+  return (num_threads, num_groups)
diff --git a/src/Futhark/Pass/ExplicitAllocations.hs b/src/Futhark/Pass/ExplicitAllocations.hs
--- a/src/Futhark/Pass/ExplicitAllocations.hs
+++ b/src/Futhark/Pass/ExplicitAllocations.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, FlexibleContexts, TupleSections, FlexibleInstances, MultiParamTypeClasses #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Futhark.Pass.ExplicitAllocations
        ( explicitAllocations
@@ -57,10 +58,31 @@
 class (MonadFreshNames m, HasScope lore m, ExplicitMemorish lore) =>
       Allocator lore m where
   addAllocStm :: AllocStm -> m ()
+
+  default addAllocStm :: (Allocable fromlore lore,
+                          Op lore ~ MemOp inner,
+                          m ~ AllocM fromlore lore)
+                      => AllocStm -> m ()
+  addAllocStm (SizeComputation name se) =
+    letBindNames_ [name] =<< toExp (coerceIntPrimExp Int64 se)
+  addAllocStm (Allocation name size space) =
+    letBindNames_ [name] $ Op $ Alloc size space
+  addAllocStm (ArrayCopy name src) =
+    letBindNames_ [name] $ BasicOp $ Copy src
+
   -- | The subexpression giving the number of elements we should
   -- allocate space for.  See 'ChunkMap' comment.
   dimAllocationSize :: SubExp -> m SubExp
 
+  default dimAllocationSize :: m ~ AllocM fromlore lore
+                               => SubExp -> m SubExp
+  dimAllocationSize (Var v) =
+    -- It is important to recurse here, as the substitution may itself
+    -- be a chunk size.
+    maybe (return $ Var v) dimAllocationSize =<< asks (M.lookup v . chunkMap)
+  dimAllocationSize size =
+    return size
+
   expHints :: Exp lore -> m [ExpHint]
   expHints e = return $ replicate (expExtTypeSize e) NoHint
 
@@ -141,38 +163,10 @@
 
 instance Allocable fromlore OutInKernel =>
          Allocator ExplicitMemory (AllocM fromlore ExplicitMemory) where
-  addAllocStm (SizeComputation name se) =
-    letBindNames_ [name] =<< toExp (coerceIntPrimExp Int64 se)
-  addAllocStm (Allocation name size space) =
-    letBindNames_ [name] $ Op $ Alloc size space
-  addAllocStm (ArrayCopy name src) =
-    letBindNames_ [name] $ BasicOp $ Copy src
-
-  dimAllocationSize (Var v) =
-    -- It is important to recurse here, as the substitution may itself
-    -- be a chunk size.
-    maybe (return $ Var v) dimAllocationSize =<< asks (M.lookup v . chunkMap)
-  dimAllocationSize size =
-    return size
-
   expHints = kernelExpHints
 
 instance Allocable fromlore OutInKernel =>
          Allocator OutInKernel (AllocM fromlore OutInKernel) where
-  addAllocStm (SizeComputation name se) =
-    letBindNames_ [name] =<< toExp (coerceIntPrimExp Int64 se)
-  addAllocStm (Allocation name size space) =
-    letBindNames_ [name] $ Op $ Alloc size space
-  addAllocStm (ArrayCopy name src) =
-    letBindNames_ [name] $ BasicOp $ Copy src
-
-  dimAllocationSize (Var v) =
-    -- It is important to recurse here, as the substitution may itself
-    -- be a chunk size.
-    maybe (return $ Var v) dimAllocationSize =<< asks (M.lookup v . chunkMap)
-  dimAllocationSize size =
-    return size
-
   expHints = inKernelExpHints
 
 runAllocM :: MonadFreshNames m =>
@@ -680,7 +674,20 @@
   space_oks <- mkSpaceOks (length rets) tbranch'
   fbranch' <- allocInFunBody space_oks fbranch
   let rets' = createBodyReturns rets space_oks
-  return $ If cond tbranch' fbranch' $ IfAttr rets' ifsort
+      res_then = bodyResult tbranch'
+      res_else = bodyResult fbranch'
+      size_ext = length res_then - length rets'
+      (ind_ses0, r_then_else) =
+        foldl (\(acc_ise,acc_ext) (r_then, r_else, i) ->
+                if r_then == r_else then ((i,r_then):acc_ise, acc_ext)
+                else (acc_ise, (r_then, r_else):acc_ext)
+              ) ([],[]) $ reverse $ zip3 res_then res_else [0..size_ext-1]
+      (r_then_ext, r_else_ext) = unzip r_then_else
+      ind_ses = zipWith (\(i,se) k -> (i-k,se)) ind_ses0 [0..length ind_ses0 - 1]
+      rets'' = foldl (\acc (i,se) -> fixExt i se acc) rets' ind_ses
+      tbranch'' = tbranch' { bodyResult = r_then_ext ++ drop size_ext res_then }
+      fbranch'' = fbranch' { bodyResult = r_else_ext ++ drop size_ext res_else }
+  return $ If cond tbranch'' fbranch'' $ IfAttr rets'' ifsort
 allocInExp e = mapExpM alloc e
   where alloc =
           identityMapper { mapOnBody = fail "Unhandled Body in ExplicitAllocations"
diff --git a/src/Futhark/Pass/ExtractKernels/Segmented.hs b/src/Futhark/Pass/ExtractKernels/Segmented.hs
--- a/src/Futhark/Pass/ExtractKernels/Segmented.hs
+++ b/src/Futhark/Pass/ExtractKernels/Segmented.hs
@@ -15,7 +15,7 @@
 import Futhark.Representation.Kernels
 import Futhark.Representation.SOACS.SOAC (nilFn)
 import Futhark.MonadFreshNames
-import Futhark.Tools
+import Futhark.Tools hiding (true, false)
 import Futhark.Pass.ExtractKernels.BlockedKernel
 
 data SegmentedVersion = OneGroupOneSegment
diff --git a/src/Futhark/Pass/KernelBabysitting.hs b/src/Futhark/Pass/KernelBabysitting.hs
--- a/src/Futhark/Pass/KernelBabysitting.hs
+++ b/src/Futhark/Pass/KernelBabysitting.hs
@@ -69,14 +69,15 @@
 
 transformStm :: ExpMap -> Stm Kernels -> BabysitM ExpMap
 
-transformStm expmap (Let pat aux (Op (Kernel desc space ts kbody))) = do
+transformStm expmap (Let pat aux ke@(Op (Kernel desc space ts kbody))) = do
   -- Go spelunking for accesses to arrays that are defined outside the
   -- kernel body and where the indices are kernel thread indices.
   scope <- askScope
   let thread_gids = map fst $ spaceDimensions space
       thread_local = S.fromList $ spaceGlobalId space : spaceLocalId space : thread_gids
-
+      free_ker_vars = freeInExp ke `S.difference` getKerVariantIds space
   kbody'' <- evalStateT (traverseKernelBodyArrayIndexes
+                         free_ker_vars
                          thread_local
                          (castScope scope <> scopeOfKernelSpace space)
                          (ensureCoalescedAccess expmap (spaceDimensions space) num_threads)
@@ -87,6 +88,12 @@
   addStm bnd'
   return $ M.fromList [ (name, bnd') | name <- patternNames pat ] <> expmap
   where num_threads = spaceNumThreads space
+        getKerVariantIds (KernelSpace glb_id loc_id grp_id _ _ _ (FlatThreadSpace strct)) =
+            let (gids, _) = unzip strct
+            in  S.fromList $ [glb_id, loc_id, grp_id] ++ gids
+        getKerVariantIds (KernelSpace glb_id loc_id grp_id _ _ _ (NestedThreadSpace strct)) =
+            let (gids, _, lids, _) = unzip4 strct
+            in  S.fromList $ [glb_id, loc_id, grp_id] ++ gids ++ lids
 
 transformStm expmap (Let pat aux e) = do
   e' <- mapExpM (transform expmap) e
@@ -99,18 +106,21 @@
   identityMapper { mapOnBody = \scope -> localScope scope . transformBody expmap }
 
 type ArrayIndexTransform m =
+  Names ->
   (VName -> Bool) ->           -- thread local?
+  (VName -> SubExp -> Bool)->  -- variant to a certain gid (given as first param)?
   (SubExp -> Maybe SubExp) ->  -- split substitution?
   Scope InKernel ->            -- type environment
   VName -> Slice SubExp -> m (Maybe (VName, Slice SubExp))
 
 traverseKernelBodyArrayIndexes :: (Applicative f, Monad f) =>
                                   Names
+                               -> Names
                                -> Scope InKernel
                                -> ArrayIndexTransform f
                                -> KernelBody InKernel
                                -> f (KernelBody InKernel)
-traverseKernelBodyArrayIndexes thread_variant outer_scope f (KernelBody () kstms kres) =
+traverseKernelBodyArrayIndexes free_ker_vars thread_variant outer_scope f (KernelBody () kstms kres) =
   KernelBody () . stmsFromList <$>
   mapM (onStm (varianceInStms mempty kstms,
                mkSizeSubsts kstms,
@@ -134,12 +144,16 @@
                 scope' = scope <> scopeOf stms
 
         onStm (variance, szsubst, _) (Let pat attr (BasicOp (Index arr is))) =
-          Let pat attr . oldOrNew <$> f isThreadLocal sizeSubst outer_scope arr is
+          Let pat attr . oldOrNew <$> f free_ker_vars isThreadLocal isGidVariant sizeSubst outer_scope arr is
           where oldOrNew Nothing =
                   BasicOp $ Index arr is
                 oldOrNew (Just (arr', is')) =
                   BasicOp $ Index arr' is'
 
+                isGidVariant gid (Var v) =
+                  gid == v || S.member gid (M.findWithDefault (S.singleton v) v variance)
+                isGidVariant _ _ = False
+
                 isThreadLocal v =
                   not $ S.null $
                   thread_variant `S.intersection`
@@ -177,7 +191,8 @@
                       -> [(VName,SubExp)]
                       -> SubExp
                       -> ArrayIndexTransform (StateT Replacements m)
-ensureCoalescedAccess expmap thread_space num_threads isThreadLocal sizeSubst outer_scope arr slice = do
+ensureCoalescedAccess expmap thread_space num_threads free_ker_vars isThreadLocal
+                      isGidVariant sizeSubst outer_scope arr slice = do
   seen <- gets $ M.lookup (arr, slice)
 
   case (seen, isThreadLocal arr, typeOf <$> M.lookup arr outer_scope) of
@@ -190,7 +205,7 @@
       -- indices are in a permuted order.
       | Just is <- sliceIndices slice,
         length is == arrayRank t,
-        Just is' <- coalescedIndexes (map Var thread_gids) is,
+        Just is' <- coalescedIndexes free_ker_vars isGidVariant (map Var thread_gids) is,
         Just perm <- is' `isPermutationOf` is ->
           replace =<< lift (rearrangeInput (nonlinearInMemory arr expmap) perm arr)
 
@@ -205,11 +220,14 @@
       | Just (Let _ _ (BasicOp (Rearrange perm _))) <- M.lookup arr expmap,
         ---- Just (Just perm) <- nonlinearInMemory arr expmap,
         not $ null perm,
+        not $ null thread_gids,
+        inner_gid <- last thread_gids,
         length slice >= length perm,
         slice' <- map (\i -> slice !! i) perm,
         DimFix inner_ind <- last slice',
         not $ null thread_gids,
-        inner_ind == (Var $ last thread_gids) ->
+        isGidVariant inner_gid inner_ind ->
+--        inner_ind == (Var $ inner_gid) ->
           return Nothing
 
       -- We are not fully indexing an array, but the remaining slice
@@ -262,7 +280,7 @@
       -- order!  Make sure that is the case.
       | Just{} <- nonlinearInMemory arr expmap ->
           case sliceIndices slice of
-            Just is | Just _ <- coalescedIndexes (map Var thread_gids) is ->
+            Just is | Just _ <- coalescedIndexes free_ker_vars isGidVariant (map Var thread_gids) is ->
                         replace =<< lift (rowMajorArray arr)
                     | otherwise ->
                         return Nothing
@@ -296,18 +314,23 @@
 allDimAreSlice (_:is) = allDimAreSlice is
 
 -- Try to move thread indexes into their proper position.
-coalescedIndexes :: [SubExp] -> [SubExp] -> Maybe [SubExp]
-coalescedIndexes tgids is
+coalescedIndexes :: Names -> (VName -> SubExp -> Bool) -> [SubExp] -> [SubExp] -> Maybe [SubExp]
+coalescedIndexes free_ker_vars isGidVariant tgids is
   -- Do Nothing if:
-  -- 1. the innermost index is the innermost thread id
-  --    (because access is already coalesced)
-  -- 2. any of the indices is a constant, i.e., kernel free variable
+  -- 1. any of the indices is a constant or a kernel free variable
   --    (because it would transpose a bigger array then needed -- big overhead).
+  -- 2. the innermost index is variant to the innermost-thread gid
+  --    (because access is likely to be already coalesced)
   | any isCt is =
-      Nothing
-  | num_is > 0 && not (null tgids) && last is == last tgids =
-      Just is
-  -- Otherwise try fix coalescing
+        Nothing
+  | any (`S.member` free_ker_vars) (mapMaybe mbVarId is) =
+        Nothing
+  | not (null tgids),
+    not (null is),
+    Var innergid <- last tgids,
+    num_is > 0 && isGidVariant innergid (last is) =
+        Just is
+  -- 3. Otherwise try fix coalescing
   | otherwise =
       Just $ reverse $ foldl move (reverse is) $ zip [0..] (reverse tgids)
   where num_is = length is
@@ -334,6 +357,9 @@
         isCt :: SubExp -> Bool
         isCt (Constant _) = True
         isCt (Var      _) = False
+
+        mbVarId (Constant _) = Nothing
+        mbVarId (Var v) = Just v
 
 coalescingPermutation :: Int -> Int -> [Int]
 coalescingPermutation num_is rank =
diff --git a/src/Futhark/Passes.hs b/src/Futhark/Passes.hs
--- a/src/Futhark/Passes.hs
+++ b/src/Futhark/Passes.hs
@@ -37,6 +37,7 @@
 standardPipeline =
   passes [ simplifySOACS
          , inlineAndRemoveDeadFunctions
+         , simplifySOACS
          , performCSE True
          , simplifySOACS
            -- We run fusion twice
diff --git a/src/Futhark/Representation/AST/Attributes.hs b/src/Futhark/Representation/AST/Attributes.hs
--- a/src/Futhark/Representation/AST/Attributes.hs
+++ b/src/Futhark/Representation/AST/Attributes.hs
@@ -31,6 +31,7 @@
   , stmCerts
   , certify
   , expExtTypesFromPattern
+  , patternFromParams
 
   , IsOp (..)
   , Attributes (..)
@@ -222,3 +223,8 @@
 expExtTypesFromPattern pat =
   existentialiseExtTypes (patternContextNames pat) $
   staticShapes $ map patElemType $ patternValueElements pat
+
+-- | Create a pattern corresponding to some parameters.
+patternFromParams :: [Param attr] -> PatternT attr
+patternFromParams = Pattern [] . map toPatElem
+  where toPatElem p = PatElem (paramName p) $ paramAttr p
diff --git a/src/Futhark/Representation/AST/Attributes/Aliases.hs b/src/Futhark/Representation/AST/Attributes/Aliases.hs
--- a/src/Futhark/Representation/AST/Attributes/Aliases.hs
+++ b/src/Futhark/Representation/AST/Attributes/Aliases.hs
@@ -74,8 +74,6 @@
   [mempty]
 primOpAliases Assert{} =
   [mempty]
-primOpAliases (Partition n _ arr) =
-  replicate n mempty ++ map vnameAliases arr
 
 ifAliases :: ([Names], Names) -> ([Names], Names) -> [Names]
 ifAliases (als1,cons1) (als2,cons2) =
diff --git a/src/Futhark/Representation/AST/Attributes/Ranges.hs b/src/Futhark/Representation/AST/Attributes/Ranges.hs
--- a/src/Futhark/Representation/AST/Attributes/Ranges.hs
+++ b/src/Futhark/Representation/AST/Attributes/Ranges.hs
@@ -210,8 +210,6 @@
   [rangeOf $ Var se]
 primOpRanges (Index v _) =
   [rangeOf $ Var v]
-primOpRanges (Partition n _ arr) =
-  replicate n unknownRange ++ map (rangeOf . Var) arr
 primOpRanges (ArrayLit (e:es) _) =
   [(Just lower, Just upper)]
   where (e_lower, e_upper) = subExpKnownRange e
diff --git a/src/Futhark/Representation/AST/Attributes/TypeOf.hs b/src/Futhark/Representation/AST/Attributes/TypeOf.hs
--- a/src/Futhark/Representation/AST/Attributes/TypeOf.hs
+++ b/src/Futhark/Representation/AST/Attributes/TypeOf.hs
@@ -119,10 +119,6 @@
   pure <$> lookupType v
 primOpType Assert{} =
   pure [Prim Cert]
-primOpType (Partition n _ arrays) =
-  result <$> traverse lookupType arrays
-  where result ts = replicate n (Prim $ IntType Int32) ++ ts
-
 
 -- | The type of an expression.
 expExtType :: (HasScope lore m, TypedOp (Op lore)) =>
diff --git a/src/Futhark/Representation/AST/Pretty.hs b/src/Futhark/Representation/AST/Pretty.hs
--- a/src/Futhark/Representation/AST/Pretty.hs
+++ b/src/Futhark/Representation/AST/Pretty.hs
@@ -206,9 +206,6 @@
   ppr (Manifest perm e) = text "manifest" <> apply [apply (map ppr perm), ppr e]
   ppr (Assert e msg (loc, _)) =
     text "assert" <> apply [ppr e, ppr msg, text $ show $ locStr loc]
-  ppr (Partition n flags arrs) =
-    text "partition" <>
-    parens (commasep $ [ ppr n, ppr flags ] ++ map ppr arrs)
 
 instance Pretty a => Pretty (ErrorMsg a) where
   ppr (ErrorMsg parts) = commasep $ map p parts
diff --git a/src/Futhark/Representation/AST/Syntax.hs b/src/Futhark/Representation/AST/Syntax.hs
--- a/src/Futhark/Representation/AST/Syntax.hs
+++ b/src/Futhark/Representation/AST/Syntax.hs
@@ -263,11 +263,6 @@
   -- ^ Rotate the dimensions of the input array.  The list of
   -- subexpressions specify how much each dimension is rotated.  The
   -- length of this list must be equal to the rank of the array.
-
-  | Partition Int VName [VName]
-    -- ^ First variable is the flag array, second is the element
-    -- arrays.  If no arrays are given, the returned offsets are zero,
-    -- and no arrays are returned.
   deriving (Eq, Ord, Show)
 
 -- | The root Futhark expression type.  The 'Op' constructor contains
diff --git a/src/Futhark/Representation/AST/Syntax/Core.hs b/src/Futhark/Representation/AST/Syntax/Core.hs
--- a/src/Futhark/Representation/AST/Syntax/Core.hs
+++ b/src/Futhark/Representation/AST/Syntax/Core.hs
@@ -302,10 +302,10 @@
   (orig_k+i*orig_s) : fixSlice mis' is'
 fixSlice _ _ = []
 
--- | An element of a pattern - consisting of an name (essentially a
--- pair of the name andtype), a 'Bindage', and an addditional
--- parametric attribute.  This attribute is what is expected to
--- contain the type of the resulting variable.
+-- | An element of a pattern - consisting of a name (essentially a
+-- pair of the name and type) and an addditional parametric attribute.
+-- This attribute is what is expected to contain the type of the
+-- resulting variable.
 data PatElemT attr = PatElem { patElemName :: VName
                                -- ^ The name being bound.
                              , patElemAttr :: attr
diff --git a/src/Futhark/Representation/AST/Traversals.hs b/src/Futhark/Representation/AST/Traversals.hs
--- a/src/Futhark/Representation/AST/Traversals.hs
+++ b/src/Futhark/Representation/AST/Traversals.hs
@@ -149,9 +149,6 @@
   BasicOp <$> (Assert <$> mapOnSubExp tv e <*> traverse (mapOnSubExp tv) msg <*> pure loc)
 mapExpM tv (BasicOp (Opaque e)) =
   BasicOp <$> (Opaque <$> mapOnSubExp tv e)
-mapExpM tv (BasicOp (Partition n flags arr)) =
-  BasicOp <$> (Partition <$>
-              pure n <*> mapOnVName tv flags <*> mapM (mapOnVName tv) arr)
 mapExpM tv (DoLoop ctxmerge valmerge form loopbody) = do
   ctxparams' <- mapM (mapOnFParam tv) ctxparams
   valparams' <- mapM (mapOnFParam tv) valparams
diff --git a/src/Futhark/Representation/ExplicitMemory.hs b/src/Futhark/Representation/ExplicitMemory.hs
--- a/src/Futhark/Representation/ExplicitMemory.hs
+++ b/src/Futhark/Representation/ExplicitMemory.hs
@@ -503,32 +503,30 @@
 bodyReturnsToExpReturns :: BodyReturns -> ExpReturns
 bodyReturnsToExpReturns = noUniquenessReturns . maybeReturns
 
+instance TC.CheckableOp ExplicitMemory where
+  checkOp (Alloc size _) = TC.require [Prim int64] size
+  checkOp (Inner k) = TC.subCheck $ typeCheckKernel k
+
+instance TC.CheckableOp InKernel where
+  checkOp (Alloc size _) = TC.require [Prim int64] size
+  checkOp (Inner k) = TC.subCheck $ typeCheckKernelExp k
+
 instance TC.Checkable ExplicitMemory where
-  checkExpLore = return
-  checkBodyLore = return
   checkFParamLore = checkMemInfo
   checkLParamLore = checkMemInfo
   checkLetBoundLore = checkMemInfo
   checkRetType = mapM_ TC.checkExtType . retTypeValues
-  checkOp (Alloc size _) = TC.require [Prim int64] size
-  checkOp (Inner k) = TC.subCheck $ typeCheckKernel k
   primFParam name t = return $ Param name (MemPrim t)
-  primLParam name t = return $ Param name (MemPrim t)
   matchPattern = matchPatternToExp
   matchReturnType = matchFunctionReturnType
   matchBranchType = matchBranchReturnType
 
 instance TC.Checkable InKernel where
-  checkExpLore = return
-  checkBodyLore = return
   checkFParamLore = checkMemInfo
   checkLParamLore = checkMemInfo
   checkLetBoundLore = checkMemInfo
   checkRetType = mapM_ TC.checkExtType . retTypeValues
-  checkOp (Alloc size _) = TC.require [Prim int64] size
-  checkOp (Inner k) = typeCheckKernelExp k
   primFParam name t = return $ Param name (MemPrim t)
-  primLParam name t = return $ Param name (MemPrim t)
   matchPattern = matchPatternToExp
   matchReturnType = matchFunctionReturnType
   matchBranchType = matchBranchReturnType
diff --git a/src/Futhark/Representation/Kernels.hs b/src/Futhark/Representation/Kernels.hs
--- a/src/Futhark/Representation/Kernels.hs
+++ b/src/Futhark/Representation/Kernels.hs
@@ -16,8 +16,6 @@
        )
 where
 
-import Control.Monad
-
 import Futhark.Representation.AST.Syntax
 import Futhark.Representation.Kernels.Kernel
 import Futhark.Representation.Kernels.KernelExp
@@ -47,37 +45,15 @@
   expTypesFromPattern = return . expExtTypesFromPattern
 instance PrettyLore InKernel where
 
-instance TypeCheck.Checkable Kernels where
-  checkExpLore = return
-  checkBodyLore = return
-  checkFParamLore _ = TypeCheck.checkType
-  checkLParamLore _ = TypeCheck.checkType
-  checkLetBoundLore _ = TypeCheck.checkType
-  checkRetType = mapM_ TypeCheck.checkExtType . retTypeValues
+instance TypeCheck.CheckableOp Kernels where
   checkOp = TypeCheck.subCheck . typeCheckKernel
-  matchPattern pat = TypeCheck.matchExtPattern pat <=< expExtType
-  primFParam name t =
-    return $ Param name (Prim t)
-  primLParam name t =
-    return $ Param name (Prim t)
-  matchReturnType = TypeCheck.matchExtReturnType . map fromDecl
-  matchBranchType = TypeCheck.matchExtBranchType
 
+instance TypeCheck.CheckableOp InKernel where
+  checkOp = TypeCheck.subCheck . typeCheckKernelExp
+
+instance TypeCheck.Checkable Kernels where
+
 instance TypeCheck.Checkable InKernel where
-  checkExpLore = return
-  checkBodyLore = return
-  checkFParamLore _ = TypeCheck.checkType
-  checkLParamLore _ = TypeCheck.checkType
-  checkLetBoundLore _ = TypeCheck.checkType
-  checkRetType = mapM_ TypeCheck.checkExtType . retTypeValues
-  checkOp = typeCheckKernelExp
-  matchPattern pat = TypeCheck.matchExtPattern pat <=< expExtType
-  primFParam name t =
-    return $ Param name (Prim t)
-  primLParam name t =
-    return $ Param name (Prim t)
-  matchReturnType = TypeCheck.matchExtReturnType . map fromDecl
-  matchBranchType = TypeCheck.matchExtBranchType
 
 instance Bindable Kernels where
   mkBody = Body ()
diff --git a/src/Futhark/Representation/Kernels/KernelExp.hs b/src/Futhark/Representation/Kernels/KernelExp.hs
--- a/src/Futhark/Representation/Kernels/KernelExp.hs
+++ b/src/Futhark/Representation/Kernels/KernelExp.hs
@@ -438,8 +438,9 @@
 instance ST.IndexOp (KernelExp lore) where
 
 instance Aliased lore => UsageInOp (KernelExp lore) where
-  usageInOp (Combine _ _ _ body) =
-    mconcat $ map UT.consumedUsage $ S.toList $ consumedInBody body
+  usageInOp (Combine cspace _ _ body) =
+    mconcat $ map UT.consumedUsage $ S.toList (consumedInBody body) <>
+    [ arr | (_, _, arr) <- cspaceScatter cspace ]
   usageInOp _ = mempty
 
 instance OpMetrics (Op lore) => OpMetrics (KernelExp lore) where
@@ -478,10 +479,12 @@
     forM_ ts_is $ \ts_i -> unless (Prim int32 == ts_i) $
       TC.bad $ TC.TypeError "Combine: index return type must be i32."
 
-    forM_ (zip (chunks as_ns ts_vs) scatter) $ \(ts_vs', (aw, _, a)) -> do
+    to_consume <- forM (zip (chunks as_ns ts_vs) scatter) $ \(ts_vs', (aw, _, a)) -> do
       TC.require [Prim int32] aw
       forM_ ts_vs' $ \ts_v -> TC.requireI [ts_v `arrayOfRow` aw] a
-      TC.consume =<< TC.lookupAliases a
+      return a
+    -- Consume all at once because it is valid to do two scatters to the same array.
+    TC.consume . mconcat =<< mapM TC.lookupAliases to_consume
 
     mapM_ TC.checkType ts
     mapM_ (TC.requireI [Prim int32]) a_is
diff --git a/src/Futhark/Representation/Kernels/Simplify.hs b/src/Futhark/Representation/Kernels/Simplify.hs
--- a/src/Futhark/Representation/Kernels/Simplify.hs
+++ b/src/Futhark/Representation/Kernels/Simplify.hs
@@ -65,7 +65,7 @@
   space' <- Engine.simplify space
   ts' <- mapM Engine.simplify ts
   outer_vtable <- Engine.askVtable
-  (((kbody_stms, kbody_res), kbody_hoisted), again) <-
+  ((kbody_stms, kbody_res), kbody_hoisted) <-
     Engine.subSimpleM (mk_ops space) env outer_vtable $ do
       par_blocker <- Engine.asksEngineEnv $ Engine.blockHoistPar . Engine.envHoistBlockers
       Engine.localVtable (<>scope_vtable) $
@@ -74,7 +74,6 @@
                         `Engine.orIf` par_blocker
                         `Engine.orIf` Engine.isConsumed) $
         simplifyKernelBodyM kbody
-  when again Engine.changed
   kbody_hoisted' <- mapM processHoistedStm kbody_hoisted
   return (Kernel desc space' ts' $ mkWiseKernelBody () kbody_stms kbody_res,
           kbody_hoisted')
diff --git a/src/Futhark/Representation/Primitive.hs b/src/Futhark/Representation/Primitive.hs
--- a/src/Futhark/Representation/Primitive.hs
+++ b/src/Futhark/Representation/Primitive.hs
@@ -68,6 +68,8 @@
        , negativeIsh
        , primBitSize
        , primByteSize
+       , intByteSize
+       , floatByteSize
        , commutativeBinOp
 
        -- * Prettyprinting
diff --git a/src/Futhark/Representation/SOACS.hs b/src/Futhark/Representation/SOACS.hs
--- a/src/Futhark/Representation/SOACS.hs
+++ b/src/Futhark/Representation/SOACS.hs
@@ -34,8 +34,6 @@
        )
 where
 
-import Control.Monad
-
 import qualified Futhark.Representation.AST.Syntax as AST
 import Futhark.Representation.AST.Syntax
   hiding (Prog, BasicOp, Exp, Body, Stm,
@@ -74,21 +72,10 @@
 type RetType = AST.RetType SOACS
 type PatElem = AST.PatElem SOACS
 
-instance TypeCheck.Checkable SOACS where
-  checkExpLore = return
-  checkBodyLore = return
-  checkFParamLore _ = TypeCheck.checkType
-  checkLParamLore _ = TypeCheck.checkType
-  checkLetBoundLore _ = TypeCheck.checkType
-  checkRetType = mapM_ TypeCheck.checkExtType . retTypeValues
+instance TypeCheck.CheckableOp SOACS where
   checkOp = typeCheckSOAC
-  matchPattern pat = TypeCheck.matchExtPattern pat <=< expExtType
-  primFParam name t =
-    return $ AST.Param name (AST.Prim t)
-  primLParam name t =
-    return $ AST.Param name (AST.Prim t)
-  matchReturnType = TypeCheck.matchExtReturnType . map fromDecl
-  matchBranchType = TypeCheck.matchExtBranchType
+
+instance TypeCheck.Checkable SOACS where
 
 instance Bindable SOACS where
   mkBody = AST.Body ()
diff --git a/src/Futhark/Representation/SOACS/SOAC.hs b/src/Futhark/Representation/SOACS/SOAC.hs
--- a/src/Futhark/Representation/SOACS/SOAC.hs
+++ b/src/Futhark/Representation/SOACS/SOAC.hs
@@ -12,13 +12,13 @@
        , Scan
        , Reduce
 
-       , typeCheckSOAC
-
          -- * Utility
        , getStreamOrder
        , getStreamAccums
        , scremaType
        , soacType
+
+       , typeCheckSOAC
 
        , mkIdentityLambda
        , isIdentityLambda
diff --git a/src/Futhark/Representation/SOACS/Simplify.hs b/src/Futhark/Representation/SOACS/Simplify.hs
--- a/src/Futhark/Representation/SOACS/Simplify.hs
+++ b/src/Futhark/Representation/SOACS/Simplify.hs
@@ -163,6 +163,7 @@
                  RuleOp removeDeadWrite,
                  RuleBasicOp removeUnnecessaryCopy,
                  RuleOp liftIdentityMapping,
+                 RuleOp liftIdentityStreaming,
                  RuleOp removeDuplicateMapOutput,
                  RuleOp mapOpToOp
                 ]
@@ -207,6 +208,35 @@
       mapM_ (uncurry letBind) invariant
       letBindNames_ (map patElemName pat') $ Op $ Screma w (mapSOAC fun') arrs
 liftIdentityMapping _ _ _ _ = cannotSimplify
+
+liftIdentityStreaming :: BottomUpRuleOp (Wise SOACS)
+liftIdentityStreaming _ (Pattern [] pes) _ (Stream w form lam arrs)
+  | (variant_map, invariant_map) <-
+      partitionEithers $ map isInvariantRes $ zip3 map_ts map_pes map_res,
+    not $ null invariant_map = do
+
+      forM_ invariant_map $ \(pe, arr) ->
+        letBind_ (Pattern [] [pe]) $ BasicOp $ Copy arr
+
+      let (variant_map_ts, variant_map_pes, variant_map_res) = unzip3 variant_map
+          lam' = lam { lambdaBody = (lambdaBody lam) { bodyResult = fold_res ++ variant_map_res }
+                     , lambdaReturnType = fold_ts ++ variant_map_ts }
+
+      letBind_ (Pattern [] $ fold_pes ++ variant_map_pes) $
+        Op $ Stream w form lam' arrs
+  where num_folds = length $ getStreamAccums form
+        (fold_pes, map_pes) = splitAt num_folds pes
+        (fold_ts, map_ts) = splitAt num_folds $ lambdaReturnType lam
+        lam_res = bodyResult $ lambdaBody lam
+        (fold_res, map_res) = splitAt num_folds lam_res
+        params_to_arrs = zip (map paramName $ drop (1 + num_folds) $ lambdaParams lam) arrs
+
+        isInvariantRes (_, pe, Var v)
+          | Just arr <- lookup v params_to_arrs =
+              Right (pe, arr)
+        isInvariantRes x =
+          Left x
+liftIdentityStreaming _ _ _ _ = cannotSimplify
 
 -- | Remove all arguments to the map that are simply replicates.
 -- These can be turned into free variables instead.
diff --git a/src/Futhark/Test.hs b/src/Futhark/Test.hs
--- a/src/Futhark/Test.hs
+++ b/src/Futhark/Test.hs
@@ -21,12 +21,15 @@
        , TestRun (..)
        , ExpectedResult (..)
        , Values (..)
+       , GenValue (..)
        , Value
        )
        where
 
 import Control.Applicative
 import qualified Data.ByteString.Lazy as BS
+import qualified Data.ByteString as SBS
+import Control.Exception (catch)
 import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.Map.Strict as M
@@ -34,6 +37,7 @@
 import Data.Functor
 import Data.Maybe
 import Data.Foldable (foldl')
+import Data.List
 import Data.Semigroup
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
@@ -47,13 +51,20 @@
 import Text.Megaparsec hiding (many, some)
 import Text.Megaparsec.Char
 import Text.Regex.TDFA
+import System.Directory
+import System.Exit
+import System.Process.ByteString (readProcessWithExitCode)
+import System.IO (withFile, IOMode(..), hFileSize)
+import System.IO.Error
 
 import Prelude
 
 import Futhark.Analysis.Metrics
-import Futhark.Util.Pretty (pretty, prettyText)
+import Futhark.Representation.Primitive (IntType(..), FloatType(..), intByteSize, floatByteSize)
 import Futhark.Test.Values
 import Futhark.Util (directoryContents)
+import Futhark.Util.Pretty (pretty, prettyText)
+import Language.Futhark.Syntax (PrimType(..), Int32)
 
 -- | Description of a test to be carried out on a Futhark program.
 -- The Futhark program is stored separately.
@@ -115,11 +126,28 @@
                }
              deriving (Show)
 
--- | Several Values - either literally, or by reference to a file.
+-- | Several Values - either literally, or by reference to a file, or
+-- to be generated on demand.
 data Values = Values [Value]
             | InFile FilePath
+            | GenValues [GenValue]
             deriving (Show)
 
+data GenValue = GenValue [Int] PrimType
+                -- ^ Generate a value of the given rank and primitive
+                -- type.  Scalars are considered 0-ary arrays.
+              | GenInt Int32
+                -- ^ A fixed non-randomised integer.
+              deriving (Show)
+
+-- | A prettyprinted representation of type of value produced by a
+-- 'GenValue'.
+genValueType :: GenValue -> String
+genValueType (GenValue ds t) =
+  concatMap (\d -> "[" ++ show d ++ "]") ds ++ pretty t
+genValueType (GenInt x) =
+  show x ++ "i32"
+
 -- | How a test case is expected to terminate.
 data ExpectedResult values
   = Succeeds (Maybe values) -- ^ Execution suceeds, with or without
@@ -159,9 +187,11 @@
 
 parseTags :: Parser [T.Text]
 parseTags = lexstr "tags" *> braces (many parseTag) <|> pure []
-  where parseTag = T.pack <$> lexeme (some $ satisfy constituent)
-        constituent c = not (isSpace c) && c /= '}'
+  where parseTag = T.pack <$> lexeme (some $ satisfy tagConstituent)
 
+tagConstituent :: Char -> Bool
+tagConstituent c = isAlphaNum c || c == '_' || c == '-'
+
 parseAction :: Parser TestAction
 parseAction = CompileTimeFailure <$> (lexstr "error:" *> parseExpectedError) <|>
               (RunCases <$> parseInputOutputs <*>
@@ -180,7 +210,7 @@
 
 parseRunTags :: Parser [String]
 parseRunTags = many parseTag
-  where parseTag = try $ lexeme $ do s <- some $ satisfy isAlphaNum
+  where parseTag = try $ lexeme $ do s <- some $ satisfy tagConstituent
                                      guard $ s `notElem` ["input", "structure", "warning"]
                                      return s
 
@@ -190,7 +220,8 @@
                            <|> pure []
         parseRunCase i = do
           tags <- parseRunTags
-          input <- parseInput
+          lexstr "input"
+          input <- if "random" `elem` tags then parseRandomValues else parseValues
           expr <- parseExpectedResult
           return $ TestRun tags input expr i $ desc i input
 
@@ -208,7 +239,8 @@
           where vs' = case unwords (map pretty vs) of
                         s | length s > 50 -> take 50 s ++ "..."
                           | otherwise     -> s
-
+        desc _ (GenValues gens) =
+          unwords $ map genValueType gens
 
 parseExpectedResult :: Parser (ExpectedResult Values)
 parseExpectedResult =
@@ -225,12 +257,34 @@
          -- newlines like ordinary characters, which is what we want.
     else ThisError s <$> makeRegexOptsM blankCompOpt defaultExecOpt (T.unpack s)
 
-parseInput :: Parser Values
-parseInput = lexstr "input" *> parseValues
+parseRandomValues :: Parser Values
+parseRandomValues = GenValues <$> between (lexstr "{") (lexstr "}") (many parseGenValue)
 
+parseGenValue :: Parser GenValue
+parseGenValue = choice [ GenValue <$> many dim <*> parsePrimType
+                       , lexeme $ GenInt . read <$> some (satisfy isDigit)
+                       ]
+  where dim = between (lexstr "[") (lexstr "]") $
+              lexeme $ read <$> some (satisfy isDigit)
+
+parsePrimType :: Parser PrimType
+parsePrimType =
+  choice [ lexstr "i8" $> Signed Int8
+         , lexstr "i16" $> Signed Int16
+         , lexstr "i32" $> Signed Int32
+         , lexstr "i64" $> Signed Int64
+         , lexstr "u8" $> Unsigned Int8
+         , lexstr "u16" $> Unsigned Int16
+         , lexstr "u32" $> Unsigned Int32
+         , lexstr "u64" $> Unsigned Int64
+         , lexstr "f32" $> FloatType Float32
+         , lexstr "f64" $> FloatType Float64
+         , lexstr "bool" $> Bool
+         ]
+
 parseValues :: Parser Values
 parseValues = do s <- parseBlock
-                 case valuesFromByteString "input" $ BS.fromStrict $ T.encodeUtf8 s of
+                 case valuesFromByteString "input block contents" $ BS.fromStrict $ T.encodeUtf8 s of
                    Left err -> fail err
                    Right vs -> return $ Values vs
               <|> lexstr "@" *> lexeme (InFile . T.unpack <$> nextWord)
@@ -380,12 +434,11 @@
 getValues :: MonadIO m => FilePath -> Values -> m [Value]
 getValues _ (Values vs) =
   return vs
-getValues dir (InFile file) = do
-  s <- getValuesBS dir (InFile file)
-  case valuesFromByteString file' s of
+getValues dir v = do
+  s <- getValuesBS dir v
+  case valuesFromByteString "file" s of
     Left e   -> fail $ show e
     Right vs -> return vs
-  where file' = dir </> file
 
 -- | Extract a pretty representation of some 'Values'.  In the IO
 -- monad because this might involve reading from a file.  There is no
@@ -405,3 +458,46 @@
   where file' = dir </> file
         readAndDecompress = do s <- BS.readFile file'
                                E.evaluate $ decompress s
+getValuesBS dir (GenValues gens) =
+  mconcat <$> mapM (getGenBS dir) gens
+
+getGenBS :: MonadIO m => FilePath -> GenValue -> m BS.ByteString
+getGenBS dir gen = do
+  exists_and_proper_size <- liftIO $
+    withFile (dir </> file) ReadMode (fmap (== genFileSize gen) . hFileSize)
+    `catch` \ex -> if isDoesNotExistError ex then return False
+                   else E.throw ex
+  unless exists_and_proper_size $ liftIO $ do
+    s <- genValues [gen]
+    createDirectoryIfMissing True $ takeDirectory $ dir </> file
+    SBS.writeFile (dir </> file) s
+  getValuesBS dir $ InFile file
+  where file = "data" </> genFileName gen
+
+genValues :: [GenValue] -> IO SBS.ByteString
+genValues gens = do
+  (code, stdout, stderr) <- readProcessWithExitCode "futhark-dataset" args mempty
+  case code of
+    ExitSuccess ->
+      return stdout
+    ExitFailure e ->
+      fail $ "futhark-dataset failed with exit code " ++ show e ++ " and stderr:\n" ++
+      map (chr . fromIntegral) (SBS.unpack stderr)
+  where args = "-b" : concatMap argForGen gens
+        argForGen g = ["-g", genValueType g]
+
+genFileName :: GenValue -> FilePath
+genFileName gen = genValueType gen ++ ".in"
+
+-- | Compute the expected size of the file.  We use this to check
+-- whether an existing file is broken/truncated.
+genFileSize :: GenValue -> Integer
+genFileSize = genSize
+  where header_size = 1 + 1 + 1 + 4 -- 'b' <version> <num_dims> <type>
+        genSize (GenValue ds t) = header_size + toInteger (length ds) * 8 +
+                                  product (map toInteger ds) * primSize t
+        genSize (GenInt _) = header_size + primSize (Signed Int32)
+        primSize (Signed it) = intByteSize it
+        primSize (Unsigned it) = intByteSize it
+        primSize (FloatType ft) = floatByteSize ft
+        primSize Bool = 1
diff --git a/src/Futhark/Test/Values.hs b/src/Futhark/Test/Values.hs
--- a/src/Futhark/Test/Values.hs
+++ b/src/Futhark/Test/Values.hs
@@ -6,12 +6,15 @@
 -- here does not support tuples, so don't use those as input/output
 -- for your test programs.
 module Futhark.Test.Values
-       ( Value
-       , valueType
+       ( Value(..)
 
        -- * Reading Values
        , readValues
 
+       -- * Types of values
+       , ValueType(..)
+       , valueType
+
        -- * Comparing Values
        , compareValues
        , Mismatch
@@ -74,13 +77,13 @@
   put (Int16Value shape vs) = putBinaryValue " i16" shape vs putInt16le
   put (Int32Value shape vs) = putBinaryValue " i32" shape vs putInt32le
   put (Int64Value shape vs) = putBinaryValue " i64" shape vs putInt64le
-  put (Word8Value shape vs) = putBinaryValue "  i8" shape vs putWord8
-  put (Word16Value shape vs) = putBinaryValue " i16" shape vs putWord16le
-  put (Word32Value shape vs) = putBinaryValue " i32" shape vs putWord32le
-  put (Word64Value shape vs) = putBinaryValue " i64" shape vs putWord64le
+  put (Word8Value shape vs) = putBinaryValue "  u8" shape vs putWord8
+  put (Word16Value shape vs) = putBinaryValue " u16" shape vs putWord16le
+  put (Word32Value shape vs) = putBinaryValue " u32" shape vs putWord32le
+  put (Word64Value shape vs) = putBinaryValue " u64" shape vs putWord64le
   put (Float32Value shape vs) = putBinaryValue " f32" shape vs putFloat32le
   put (Float64Value shape vs) = putBinaryValue " f64" shape vs putFloat64le
-  put (BoolValue shape vs) = putBinaryValue " f64" shape vs $ putInt8 . boolToInt
+  put (BoolValue shape vs) = putBinaryValue "bool" shape vs $ putInt8 . boolToInt
     where boolToInt True = 1
           boolToInt False = 0
 
@@ -133,7 +136,7 @@
 instance PP.Pretty Value where
   ppr v | product (valueShape v) == 0 =
             text "empty" <>
-            parens (dims <> text (valueElemType v))
+            parens (dims <> ppr (valueElemType v))
     where dims = mconcat $ replicate (length (valueShape v)-1) $ text "[]"
   ppr (Int8Value shape vs) = pprArray (UVec.toList shape) vs
   ppr (Int16Value shape vs) = pprArray (UVec.toList shape) vs
@@ -155,24 +158,31 @@
   where slice_size = product ds
         slice i = UVec.slice (i*slice_size) slice_size vs
 
+-- | A representation of the simple values we represent in this module.
+data ValueType = ValueType [Int] F.PrimType
+               deriving (Show)
+
+instance PP.Pretty ValueType where
+  ppr (ValueType ds t) = mconcat (map pprDim ds) <> ppr t
+    where pprDim d = brackets $ ppr d
+
 -- | A textual description of the type of a value.  Follows Futhark
 -- type notation, and contains the exact dimension sizes if an array.
-valueType :: Value -> String
-valueType v = concatMap (\d -> "[" ++ show d ++ "]") (valueShape v) ++
-              valueElemType v
+valueType :: Value -> ValueType
+valueType v = ValueType (valueShape v) $ valueElemType v
 
-valueElemType :: Value -> String
-valueElemType (Int8Value _ _) = "i8"
-valueElemType (Int16Value _ _) = "i16"
-valueElemType (Int32Value _ _) = "i32"
-valueElemType (Int64Value _ _) = "i64"
-valueElemType (Word8Value _ _) = "u8"
-valueElemType (Word16Value _ _) = "u16"
-valueElemType (Word32Value _ _) = "u32"
-valueElemType (Word64Value _ _) = "u64"
-valueElemType (Float32Value _ _) = "f32"
-valueElemType (Float64Value _ _) = "f64"
-valueElemType (BoolValue _ _) = "bool"
+valueElemType :: Value -> F.PrimType
+valueElemType Int8Value{} = F.Signed F.Int8
+valueElemType Int16Value{} = F.Signed F.Int16
+valueElemType Int32Value{} = F.Signed F.Int32
+valueElemType Int64Value{} = F.Signed F.Int64
+valueElemType Word8Value{} = F.Unsigned F.Int8
+valueElemType Word16Value{} = F.Unsigned F.Int16
+valueElemType Word32Value{} = F.Unsigned F.Int32
+valueElemType Word64Value{} = F.Unsigned F.Int64
+valueElemType Float32Value{} = F.FloatType F.Float32
+valueElemType Float64Value{} = F.FloatType F.Float64
+valueElemType BoolValue{} = F.Bool
 
 valueShape :: Value -> [Int]
 valueShape (Int8Value shape _) = UVec.toList shape
@@ -348,15 +358,15 @@
 readFloat32 :: ReadValue Float
 readFloat32 = readFloat lexFloat32
   where lexFloat32 [F32LIT x] = Just x
-        lexFloat32 [ID "f32", DOT, ID "inf"] = Just $ 1/0
-        lexFloat32 [ID "f32", DOT, ID "nan"] = Just $ 0/0
+        lexFloat32 [ID "f32", PROJ_FIELD "inf"] = Just $ 1/0
+        lexFloat32 [ID "f32", PROJ_FIELD "nan"] = Just $ 0/0
         lexFloat32 _ = Nothing
 
 readFloat64 :: ReadValue Double
 readFloat64 = readFloat lexFloat64
   where lexFloat64 [F64LIT x] = Just x
-        lexFloat64 [ID "f64", DOT, ID "inf"] = Just $ 1/0
-        lexFloat64 [ID "f64", DOT, ID "nan"] = Just $ 0/0
+        lexFloat64 [ID "f64", PROJ_FIELD "inf"] = Just $ 1/0
+        lexFloat64 [ID "f64", PROJ_FIELD "nan"] = Just $ 0/0
         lexFloat64 _          = Nothing
 
 readBool :: ReadValue Bool
@@ -504,7 +514,7 @@
       (BoolValue _ got_vs, BoolValue _ expected_vs) ->
         compareGen compareBool got_vs expected_vs
       _ ->
-        Just $ TypeMismatch i (valueElemType got_v) (valueElemType expected_v)
+        Just $ TypeMismatch i (pretty $ valueElemType got_v) (pretty $ valueElemType expected_v)
   | otherwise =
       Just $ ArrayShapeMismatch i (valueShape got_v) (valueShape expected_v)
   where compareNum tol = compareGen $ compareElement tol
diff --git a/src/Futhark/Tools.hs b/src/Futhark/Tools.hs
--- a/src/Futhark/Tools.hs
+++ b/src/Futhark/Tools.hs
@@ -159,16 +159,12 @@
 
   -- The number of results in the body matches exactly the size (and
   -- order) of 'pat', so we bind them up here, again with a reshape to
-  -- make the types work out.  We also do a copy to ensure that the
-  -- result does not have any aliases (as the semantics of Stream
-  -- require).
+  -- make the types work out.
   forM_ (zip (patternElements pat) $ bodyResult $ lambdaBody lam) $ \(pe, se) ->
     case (arrayDims $ patElemType pe, se) of
       (dims, Var v)
-        | not $ null dims -> do
-            v_reshaped <- letExp (baseString v <> "_reshaped") $
-                          BasicOp $ Reshape (map DimCoercion dims) v
-            letBindNames_ [patElemName pe] $ BasicOp $ Copy v_reshaped
+        | not $ null dims ->
+            letBindNames_ [patElemName pe] $ BasicOp $ Reshape (map DimCoercion dims) v
       _ -> letBindNames_ [patElemName pe] $ BasicOp $ SubExp se
 
 partitionChunkedFoldParameters :: Int -> [Param attr]
diff --git a/src/Futhark/TypeCheck.hs b/src/Futhark/TypeCheck.hs
--- a/src/Futhark/TypeCheck.hs
+++ b/src/Futhark/TypeCheck.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables #-}
+{-# LANGUAGE DefaultSignatures #-}
 -- | The type checker checks whether the program is type-consistent.
 module Futhark.TypeCheck
   ( -- * Interface
@@ -12,6 +13,7 @@
   , context
   , message
   , Checkable (..)
+  , CheckableOp (..)
   , lookupVar
   , lookupAliases
   , Occurences
@@ -780,17 +782,6 @@
 checkBasicOp (Assert e _ _) =
   require [Prim Bool] e
 
-checkBasicOp (Partition _ flags arrs) = do
-  flagst <- lookupType flags
-  unless (rowType flagst == Prim int32) $
-    bad $ TypeError $ "Flag array has type " ++ pretty flagst ++ "."
-  forM_ arrs $ \arr -> do
-    arrt <- lookupType arr
-    unless (arrayRank arrt > 0) $
-      bad $ TypeError $
-      "Array argument " ++ pretty arr ++
-      " to partition has type " ++ pretty arrt ++ "."
-
 checkExp :: Checkable lore =>
             Exp (Aliases lore) -> TypeM lore ()
 
@@ -1082,17 +1073,48 @@
   unless (primExpType e == t) $ bad $ TypeError $
     pretty e ++ " must have type " ++ pretty t
 
+class Attributes lore => CheckableOp lore where
+  checkOp :: OpWithAliases (Op lore) -> TypeM lore ()
+
 -- | The class of lores that can be type-checked.
-class (Attributes lore, CanBeAliased (Op lore)) => Checkable lore where
+class (Attributes lore, CanBeAliased (Op lore), CheckableOp lore) => Checkable lore where
   checkExpLore :: ExpAttr lore -> TypeM lore ()
   checkBodyLore :: BodyAttr lore -> TypeM lore ()
   checkFParamLore :: VName -> FParamAttr lore -> TypeM lore ()
   checkLParamLore :: VName -> LParamAttr lore -> TypeM lore ()
   checkLetBoundLore :: VName -> LetAttr lore -> TypeM lore ()
   checkRetType :: [RetType lore] -> TypeM lore ()
-  checkOp :: OpWithAliases (Op lore) -> TypeM lore ()
   matchPattern :: Pattern (Aliases lore) -> Exp (Aliases lore) -> TypeM lore ()
   primFParam :: VName -> PrimType -> TypeM lore (FParam (Aliases lore))
-  primLParam :: VName -> PrimType -> TypeM lore (LParam (Aliases lore))
   matchReturnType :: [RetType lore] -> Result -> TypeM lore ()
   matchBranchType :: [BranchType lore] -> Body (Aliases lore) -> TypeM lore ()
+
+  default checkExpLore :: ExpAttr lore ~ () => ExpAttr lore -> TypeM lore ()
+  checkExpLore = return
+
+  default checkBodyLore :: BodyAttr lore ~ () => BodyAttr lore -> TypeM lore ()
+  checkBodyLore = return
+
+  default checkFParamLore :: FParamAttr lore ~ DeclType => VName -> FParamAttr lore -> TypeM lore ()
+  checkFParamLore _ = checkType
+
+  default checkLParamLore :: LParamAttr lore ~ Type => VName -> LParamAttr lore -> TypeM lore ()
+  checkLParamLore _ = checkType
+
+  default checkLetBoundLore :: LetAttr lore ~ Type => VName -> LetAttr lore -> TypeM lore ()
+  checkLetBoundLore _ = checkType
+
+  default checkRetType :: RetType lore ~ DeclExtType => [RetType lore] -> TypeM lore ()
+  checkRetType = mapM_ checkExtType . retTypeValues
+
+  default matchPattern :: Pattern (Aliases lore) -> Exp (Aliases lore) -> TypeM lore ()
+  matchPattern pat = matchExtPattern pat <=< expExtType
+
+  default primFParam :: FParamAttr lore ~ DeclType => VName -> PrimType -> TypeM lore (FParam (Aliases lore))
+  primFParam name t = return $ Param name (Prim t)
+
+  default matchReturnType :: RetType lore ~ DeclExtType => [RetType lore] -> Result -> TypeM lore ()
+  matchReturnType = matchExtReturnType . map fromDecl
+
+  default matchBranchType :: BranchType lore ~ ExtType => [BranchType lore] -> Body (Aliases lore) -> TypeM lore ()
+  matchBranchType = matchExtBranchType
diff --git a/src/Language/Futhark.hs b/src/Language/Futhark.hs
--- a/src/Language/Futhark.hs
+++ b/src/Language/Futhark.hs
@@ -9,7 +9,7 @@
   , ValBind, Dec, Spec, Prog
   , TypeBind, TypeDecl
   , StructTypeArg, ArrayElemType
-  , TypeParam
+  , TypeParam, Case
   )
   where
 
@@ -71,3 +71,6 @@
 -- | A known array element type with no shape annotations, but aliasing
 -- information.
 type ArrayElemType = ArrayElemTypeBase () Names
+
+-- | A type-checked case (of a match expression).
+type Case = CaseBase Info VName
diff --git a/src/Language/Futhark/Attributes.hs b/src/Language/Futhark/Attributes.hs
--- a/src/Language/Futhark/Attributes.hs
+++ b/src/Language/Futhark/Attributes.hs
@@ -29,6 +29,7 @@
   , patIdentSet
   , patternType
   , patternStructType
+  , patternPatternType
   , patternParam
   , patternNoShapeAnnotations
   , patternOrderZero
@@ -94,6 +95,7 @@
   , UncheckedValBind
   , UncheckedDec
   , UncheckedProg
+  , UncheckedCase
   )
   where
 
@@ -136,12 +138,14 @@
             Prim{}              -> mempty
             TypeVar _ _ _ targs -> concatMap typeArgDims targs
             Arrow _ v t1 t2     -> filter (notV v) $ nestedDims t1 <> nestedDims t2
+            Enum{}              -> []
   where arrayNestedDims ArrayPrimElem{} =
           mempty
         arrayNestedDims (ArrayPolyElem _ targs _) =
           concatMap typeArgDims targs
         arrayNestedDims (ArrayRecordElem ts) =
           fold (fmap recordArrayElemNestedDims ts)
+        arrayNestedDims ArrayEnumElem{} = mempty
 
         recordArrayElemNestedDims (RecordArrayArrayElem a ds _) =
           arrayNestedDims a <> shapeDims ds
@@ -202,6 +206,7 @@
 diet (Arrow _ _ t1 t2)     = FuncDiet (diet t1) (diet t2)
 diet (Array _ _ Unique)    = Consume
 diet (Array _ _ Nonunique) = Observe
+diet (Enum _)              = Observe
 
 -- | @t `maskAliases` d@ removes aliases (sets them to 'mempty') from
 -- the parts of @t@ that are denoted as 'Consumed' by the 'Diet' @d@.
@@ -249,7 +254,11 @@
   where asType (RecordArrayElem (ArrayPrimElem bt _)) = Prim bt
         asType (RecordArrayElem (ArrayPolyElem bt targs als)) = TypeVar als u bt targs
         asType (RecordArrayElem (ArrayRecordElem ts')) = Record $ fmap asType ts'
+        asType (RecordArrayElem (ArrayEnumElem cs _)) = Enum cs
         asType (RecordArrayArrayElem et e_shape _) = Array et e_shape u
+peelArray n (Array (ArrayEnumElem cs _) shape _)
+  | shapeRank shape == n =
+    Just $ Enum cs
 peelArray n (Array et shape u) = do
   shape' <- stripDims n shape
   return $ Array et shape' u
@@ -291,6 +300,8 @@
   ts' <- traverse (typeToRecordArrayElem' as) ts
   return $ Array (ArrayRecordElem ts') shape u
 arrayOfWithAliases Arrow{} _ _ _ = Nothing
+arrayOfWithAliases (Enum cs) as shape u  =
+  Just $ Array (ArrayEnumElem cs as) shape u
 
 typeToRecordArrayElem :: Monoid as =>
                          TypeBase dim as
@@ -310,6 +321,8 @@
 typeToRecordArrayElem' _ (Array et shape u) =
   Just $ RecordArrayArrayElem et shape u
 typeToRecordArrayElem' _ Arrow{} = Nothing
+typeToRecordArrayElem' as (Enum cs) =
+  Just $ RecordArrayElem $ ArrayEnumElem cs as
 
 recordArrayElemToType :: Monoid as =>
                          RecordArrayElemTypeBase dim as
@@ -323,6 +336,7 @@
 arrayElemToType (ArrayRecordElem ts) =
   let ts' = fmap recordArrayElemToType ts
   in (Record $ fmap fst ts', foldMap snd ts')
+arrayElemToType (ArrayEnumElem cs als) = (Enum cs, als)
 
 -- | @stripArray n t@ removes the @n@ outermost layers of the array.
 -- Essentially, it is the type of indexing an array of type @t@ with
@@ -392,6 +406,7 @@
           RecordArrayElem $ setArrayElemUniqueness et u
         set (RecordArrayArrayElem et shape e_u) =
           RecordArrayArrayElem (setArrayElemUniqueness et u) shape e_u
+setArrayElemUniqueness (ArrayEnumElem cs as) _ = ArrayEnumElem cs as
 
 -- | @t \`setAliases\` als@ returns @t@, but with @als@ substituted for
 -- any already present aliasing.
@@ -493,6 +508,8 @@
   removeShapeAnnotations t
 typeOf (IndexSection _ (Info t) _) =
   removeShapeAnnotations t
+typeOf (VConstr0 _ (Info t) _)  = t
+typeOf (Match _ _ (Info t) _) = t
 
 foldFunType :: Monoid as => [TypeBase dim as] -> TypeBase dim as -> TypeBase dim as
 foldFunType ps ret = foldr (Arrow mempty Nothing) ret ps
@@ -518,6 +535,8 @@
       mconcat $ typeVarFree tn : map typeArgFree targs
     Array (ArrayRecordElem fields) _ _ ->
       foldMap (typeVars . fst . recordArrayElemToType) fields
+    Array ArrayEnumElem{} _ _ -> mempty
+    Enum{} -> mempty
   where typeVarFree = S.singleton . typeLeaf
         typeArgFree (TypeArgType ta _) = typeVars ta
         typeArgFree TypeArgDim{} = mempty
@@ -544,6 +563,7 @@
 returnType (Arrow _ v t1 t2) ds args =
   Arrow als v (bimap id (const mempty) t1) (returnType t2 ds args)
   where als = foldMap aliases $ zipWith maskAliases args ds
+returnType (Enum cs) _ _ = Enum cs
 
 typeArgReturnType :: TypeArg shape () -> [Diet] -> [CompType]
                   -> TypeArg shape Names
@@ -564,6 +584,9 @@
   where als = mconcat $ map aliases $ zipWith maskAliases args ds
 arrayElemReturnType (ArrayRecordElem et) ds args =
   ArrayRecordElem $ fmap (\t -> recordArrayElemReturnType t ds args) et
+arrayElemReturnType (ArrayEnumElem cs ()) ds args =
+  ArrayEnumElem cs als
+  where als = mconcat $ map aliases $ zipWith maskAliases args ds
 
 recordArrayElemReturnType :: RecordArrayElemTypeBase dim ()
                          -> [Diet]
@@ -580,10 +603,12 @@
 concreteType TypeVar{} = False
 concreteType Arrow{} = False
 concreteType (Record ts) = all concreteType ts
+concreteType Enum{} = True
 concreteType (Array at _ _) = concreteArrayType at
   where concreteArrayType ArrayPrimElem{}      = True
         concreteArrayType ArrayPolyElem{}      = False
         concreteArrayType (ArrayRecordElem ts) = all concreteRecordArrayElem ts
+        concreteArrayType ArrayEnumElem{}      = True
 
         concreteRecordArrayElem (RecordArrayElem et) = concreteArrayType et
         concreteRecordArrayElem (RecordArrayArrayElem et _ _) = concreteArrayType et
@@ -597,6 +622,7 @@
 orderZero (Record fs)     = all orderZero $ M.elems fs
 orderZero TypeVar{}       = True
 orderZero Arrow{}         = False
+orderZero Enum{}          = True
 
 -- | Extract all the shape names that occur in a given pattern.
 patternDimNames :: PatternBase Info VName -> Names
@@ -607,6 +633,7 @@
 patternDimNames (Wildcard (Info tp) _) = typeDimNames tp
 patternDimNames (PatternAscription p (TypeDecl _ (Info t)) _) =
   patternDimNames p <> typeDimNames t
+patternDimNames (PatternLit _ (Info tp) _) = typeDimNames tp
 
 -- | Extract all the shape names that occur in a given type.
 typeDimNames :: TypeBase (DimDecl VName) als -> Names
@@ -625,15 +652,17 @@
   Id _ (Info t) _         -> orderZero t
   Wildcard (Info t) _     -> orderZero t
   PatternAscription p _ _ -> patternOrderZero p
+  PatternLit _ (Info t) _ -> orderZero t
 
 -- | The set of identifiers bound in a pattern.
 patIdentSet :: (Functor f, Ord vn) => PatternBase f vn -> S.Set (IdentBase f vn)
-patIdentSet (Id v t loc)            = S.singleton $ Ident v (removeShapeAnnotations <$> t) loc
+patIdentSet (Id v t loc)              = S.singleton $ Ident v (removeShapeAnnotations <$> t) loc
 patIdentSet (PatternParens p _)       = patIdentSet p
 patIdentSet (TuplePattern pats _)     = mconcat $ map patIdentSet pats
 patIdentSet (RecordPattern fs _)      = mconcat $ map (patIdentSet . snd) fs
 patIdentSet Wildcard{}                = mempty
 patIdentSet (PatternAscription p _ _) = patIdentSet p
+patIdentSet PatternLit{}              = mempty
 
 -- | The type of values bound by the pattern.
 patternType :: PatternBase Info VName -> CompType
@@ -643,15 +672,21 @@
 patternType (TuplePattern pats _)     = tupleRecord $ map patternType pats
 patternType (RecordPattern fs _)      = Record $ patternType <$> M.fromList fs
 patternType (PatternAscription p _ _) = patternType p
+patternType (PatternLit _ (Info t) _) = removeShapeAnnotations t
 
+-- | The type of a pattern, including shape annotations.
+patternPatternType :: PatternBase Info VName -> PatternType
+patternPatternType (Wildcard (Info t) _)      = t
+patternPatternType (PatternParens p _)        = patternPatternType p
+patternPatternType (Id _ (Info t) _)          = t
+patternPatternType (TuplePattern pats _)      = tupleRecord $ map patternPatternType pats
+patternPatternType (RecordPattern fs _)       = Record $ patternPatternType <$> M.fromList fs
+patternPatternType (PatternAscription p _ _)  = patternPatternType p
+patternPatternType (PatternLit _ (Info t) _)  = t
+
 -- | The type matched by the pattern, including shape declarations if present.
 patternStructType :: PatternBase Info VName -> StructType
-patternStructType (PatternAscription p _ _) = patternStructType p
-patternStructType (PatternParens p _) = patternStructType p
-patternStructType (Id _ (Info t) _) = t `setAliases` ()
-patternStructType (TuplePattern ps _) = tupleRecord $ map patternStructType ps
-patternStructType (RecordPattern fs _) = Record $ patternStructType <$> M.fromList fs
-patternStructType (Wildcard (Info t) _) = vacuousShapeAnnotations $ toStruct t
+patternStructType = toStruct . patternPatternType
 
 -- | When viewed as a function parameter, does this pattern correspond
 -- to a named parameter of some type?
@@ -679,6 +714,8 @@
   RecordPattern (map (fmap patternNoShapeAnnotations) ps) loc
 patternNoShapeAnnotations (Wildcard (Info t) loc) =
   Wildcard (Info (vacuousShapeAnnotations t)) loc
+patternNoShapeAnnotations (PatternLit e (Info t) loc) =
+  PatternLit e (Info (vacuousShapeAnnotations t)) loc
 
 -- | Names of primitive types to types.  This is only valid if no
 -- shadowing is going on, but useful for tools.
@@ -914,12 +951,13 @@
 
 -- | The modules imported by a single declaration.
 decImports :: DecBase f vn -> [(String,SrcLoc)]
-decImports (OpenDec x _ _) = modExpImports x
+decImports (OpenDec x _) = modExpImports x
 decImports (ModDec md) = modExpImports $ modExp md
 decImports SigDec{} = []
 decImports TypeDec{} = []
 decImports ValDec{} = []
 decImports (LocalDec d _) = decImports d
+decImports (ImportDec x _ loc) = [(x, loc)]
 
 modExpImports :: ModExpBase f vn -> [(String,SrcLoc)]
 modExpImports ModVar{}              = []
@@ -934,13 +972,14 @@
 -- declaration.
 progModuleTypes :: Ord vn => ProgBase f vn -> S.Set vn
 progModuleTypes = mconcat . map onDec . progDecs
-  where onDec (OpenDec x _ _) = onModExp x
+  where onDec (OpenDec x _) = onModExp x
         onDec (ModDec md) =
           maybe mempty (onSigExp . fst) (modSignature md) <> onModExp (modExp md)
         onDec SigDec{} = mempty
         onDec TypeDec{} = mempty
         onDec ValDec{} = mempty
-        onDec (LocalDec _ _) = mempty
+        onDec LocalDec{} = mempty
+        onDec ImportDec{} = mempty
 
         onModExp ModVar{} = mempty
         onModExp (ModParens p _) = onModExp p
@@ -1035,3 +1074,6 @@
 
 -- | A Futhark program with no type annotations.
 type UncheckedProg = ProgBase NoInfo Name
+
+-- | A case (of a match expression) with no type annotations.
+type UncheckedCase = CaseBase NoInfo Name
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
@@ -17,6 +17,7 @@
   , isEmptyArray
   ) where
 
+import Control.Monad.Trans.Maybe
 import Control.Monad.Free.Church
 import Control.Monad.Except
 import Control.Monad.Reader
@@ -88,11 +89,13 @@
            | ValueArray !(Array Int Value)
            | ValueRecord (M.Map Name Value)
            | ValueFun (Value -> EvalM Value)
+           | ValueEnum Name
 
 instance Eq Value where
   ValuePrim x == ValuePrim y = x == y
   ValueArray x == ValueArray y = x == y
   ValueRecord x == ValueRecord y = x == y
+  ValueEnum x == ValueEnum y = x == y
   _ == _ = False
 
 prettyRecord :: Pretty a => M.Map Name a -> Doc
@@ -115,6 +118,7 @@
 
   ppr (ValueRecord m) = prettyRecord m
   ppr ValueFun{} = text "#<fun>"
+  ppr (ValueEnum n) = text "#" <> ppr n
 
 -- | Create an array value; failing if that would result in an
 -- irregular array.
@@ -287,30 +291,43 @@
 
 matchPattern :: Env -> Pattern -> Value
              -> EvalM (M.Map VName (Maybe T.BoundV, Value))
-matchPattern env = matchPattern' env mempty
+matchPattern env p v = do
+  m <- runMaybeT $ patternMatch env mempty p v
+  case m of
+    Nothing    -> error $ "matchPattern: missing case for " ++ pretty p ++ " and " ++ pretty v
+    Just binds -> return binds
 
-matchPattern' :: Env -> M.Map VName (Maybe T.BoundV, Value)
-              -> Pattern -> Value
-              -> EvalM (M.Map VName (Maybe T.BoundV, Value))
-matchPattern' _ m (Id v (Info t) _) val =
-  pure $ M.insert v (Just $ T.BoundV [] $ toStruct t, val) m
-matchPattern' env m (PatternParens p _) val =
-  matchPattern' env m p val
-matchPattern' env m (TuplePattern ps _) (ValueRecord vs) =
-  foldM (\m' (p,v) -> matchPattern' env m' p v) m $
-  zip ps (map snd $ sortFields vs)
-matchPattern' env m (RecordPattern ps _) (ValueRecord vs) =
-  foldM (\m' (p,v) -> matchPattern' env m' p v) m $
-  zip (map snd $ sortFields $ M.fromList ps) (map snd $ sortFields vs)
-matchPattern' _ m Wildcard{} _ = pure m
-matchPattern' env m (PatternAscription pat td loc) v = do
-  t <- evalType env $ unInfo $ expandedType td
+patternMatch :: Env -> M.Map VName (Maybe T.BoundV, Value)
+             -> Pattern -> Value
+             -> MaybeT EvalM (M.Map VName (Maybe T.BoundV, Value))
+patternMatch _ m (Id v (Info t) _) val =
+  lift $ pure $ M.insert v (Just $ T.BoundV [] $ toStruct t, val) m
+patternMatch _ m Wildcard{} _ =
+  lift $ pure m
+patternMatch env m (TuplePattern ps _) (ValueRecord vs)
+  | length ps == length vs' =
+    foldM (\m' (p,v) -> patternMatch env m' p v) m $
+    zip ps (map snd $ sortFields vs)
+    where vs' = sortFields vs
+patternMatch env m (RecordPattern ps _) (ValueRecord vs)
+  | length ps == length vs' =
+    foldM (\m' (p,v) -> patternMatch env m' p v) m $
+    zip (map snd $ sortFields $ M.fromList ps) (map snd $ sortFields vs)
+    where vs' = sortFields vs
+patternMatch env m (PatternParens p _) v = patternMatch env m p v
+patternMatch env m (PatternAscription p td loc) v = do
+  t <- lift $ evalType env $ unInfo $ expandedType td
   case matchValueToType env m t v of
-    Left err -> bad loc env err
-    Right m' -> matchPattern' env m' pat v
-matchPattern' _ _ pat v =
-  error $ "matchPattern': missing case for " ++ pretty pat ++ " and " ++ pretty v
+    Left err -> lift $ bad loc env err
+    Right m' -> patternMatch env m' p v
+patternMatch env m (PatternLit e _ _) v = do
+  v' <- lift $ eval env e
+  if v == v'
+    then pure m
+    else mzero
 
+patternMatch _ _ _ _ = mzero
+
 -- | For matching size annotations (the actual type will have been
 -- verified by the type checker).  It is assumed that previously
 -- unbound names are in binding position here.
@@ -511,6 +528,7 @@
           t'' <- evalType env t'
           return (mempty, M.singleton p $ T.TypeAbbr l [] t'')
         matchPtoA _ _ = return mempty
+evalType _ (Enum cs) = return $ Enum cs
 
 eval :: Env -> Exp -> EvalM Value
 
@@ -717,7 +735,7 @@
         zero = (`P.doMul` Int64Value 0)
 
         forLoop iv bound i v
-          | i == bound = return v
+          | i >= bound = return v
           | otherwise = do
               env' <- withLoopParams v
               forLoop iv bound (inc i) =<<
@@ -749,8 +767,27 @@
   unless cond $ bad loc env s
   eval env e
 
+eval _ (VConstr0 c _ _) = return $ ValueEnum c
+
+eval env (Match e cs _ _) = do
+  v <- eval env e
+  match v cs
+  where match v [] =
+          fail "Pattern match failure."
+        match v (c:cs) = do
+          c' <- evalCase v env c
+          case c' of
+            Just v' -> return v'
+            Nothing -> match v cs
+
 eval _ e = error $ "eval not yet: " ++ show e
 
+evalCase :: Value -> Env -> CaseBase Info VName
+         -> EvalM (Maybe Value)
+evalCase v env (CasePat p cExp _) = runMaybeT $ do
+  pEnv <- valEnv <$> patternMatch env mempty p v
+  lift $ eval (pEnv <> env) cExp
+
 substituteInModule :: M.Map VName VName -> Module -> Module
 substituteInModule substs = onModule
   where
@@ -821,9 +858,12 @@
   val <- eval env $ Lambda tps ps def Nothing (Info (mempty, t')) loc
   return $ valEnv (M.singleton v (Just ftype, val)) <> env
 
-evalDec env (OpenDec me (Info _) _) = do
+evalDec env (OpenDec me _) = do
   Module me' <- evalModExp env me
   return $ me' <> env
+
+evalDec env (ImportDec name name' loc) =
+  evalDec env $ LocalDec (OpenDec (ModImport name name' loc) loc) loc
 
 evalDec env (LocalDec d _) = evalDec env d
 evalDec env SigDec{} = return env
diff --git a/src/Language/Futhark/Parser/Lexer.x b/src/Language/Futhark/Parser/Lexer.x
--- a/src/Language/Futhark/Parser/Lexer.x
+++ b/src/Language/Futhark/Parser/Lexer.x
@@ -76,14 +76,11 @@
   ","                      { tokenC COMMA }
   "_"                      { tokenC UNDERSCORE }
   "->"                     { tokenC RIGHT_ARROW }
-  "<-"                     { tokenC LEFT_ARROW }
   ":"                      { tokenC COLON }
-  "."                      { tokenC DOT }
   "\"                      { tokenC BACKSLASH }
   "'"                      { tokenC APOSTROPHE }
   "'^"                     { tokenC APOSTROPHE_THEN_HAT }
   "`"                      { tokenC BACKTICK }
-  "#"                      { tokenC HASH }
   "..<"                    { tokenC TWO_DOTS_LT }
   "..>"                    { tokenC TWO_DOTS_GT }
   "..."                    { tokenC THREE_DOTS }
@@ -113,12 +110,16 @@
   @qualidentifier "["      { tokenM $ fmap (uncurry QUALINDEXING) . mkQualId . T.takeWhile (/='[') }
   @identifier "." "("      { tokenM $ fmap (QUALPAREN []) . indexing . T.init . T.takeWhile (/='(') }
   @qualidentifier "." "("  { tokenM $ fmap (uncurry QUALPAREN) . mkQualId . T.init . T.takeWhile (/='(') }
+  "#" @identifier          { tokenS $ CONSTRUCTOR . nameFromText . T.drop 1 }
 
   @unop                    { tokenS $ UNOP . nameFromText }
   @qualunop                { tokenM $ fmap (uncurry QUALUNOP) . mkQualId }
 
   @binop                   { tokenM $ return . symbol [] . nameFromText }
   @qualbinop               { tokenM $ \s -> do (qs,k) <- mkQualId s; return (symbol qs k) }
+
+  "." (@identifier|[0-9]+) { tokenM $ return . PROJ_FIELD . nameFromText . T.drop 1 }
+  "." "["                  { tokenC PROJ_INDEX }
 {
 
 keyword :: T.Text -> Token
@@ -146,6 +147,8 @@
     "while"        -> WHILE
     "unsafe"       -> UNSAFE
     "assert"       -> ASSERT
+    "match"        -> MATCH
+    "case"         -> CASE
 
     _              -> ID $ nameFromText s
 
@@ -215,6 +218,7 @@
   | nameToText q == "-" = NEGATE
   | nameToText q == "<" = LTH
   | nameToText q == "^" = HAT
+  | nameToText q == "|" = PIPE
   | otherwise = SYMBOL (leadingOperator q) [] q
 symbol qs q = SYMBOL (leadingOperator q) qs q
 
@@ -295,6 +299,9 @@
            | UNOP Name
            | QUALUNOP [Name] Name
            | SYMBOL BinOp [Name] Name
+           | CONSTRUCTOR Name
+           | PROJ_FIELD Name
+           | PROJ_INDEX
 
            | INTLIT Integer
            | STRINGLIT String
@@ -316,8 +323,6 @@
            | APOSTROPHE
            | APOSTROPHE_THEN_HAT
            | BACKTICK
-           | HASH
-           | DOT
            | TWO_DOTS
            | TWO_DOTS_LT
            | TWO_DOTS_GT
@@ -332,13 +337,13 @@
            | COMMA
            | UNDERSCORE
            | RIGHT_ARROW
-           | LEFT_ARROW
 
            | EQU
            | ASTERISK
            | NEGATE
            | LTH
            | HAT
+           | PIPE
 
            | IF
            | THEN
@@ -362,6 +367,8 @@
            | VAL
            | OPEN
            | LOCAL
+           | MATCH
+           | CASE
 
            | DOC String
 
diff --git a/src/Language/Futhark/Parser/Parser.y b/src/Language/Futhark/Parser/Parser.y
--- a/src/Language/Futhark/Parser/Parser.y
+++ b/src/Language/Futhark/Parser/Parser.y
@@ -56,6 +56,8 @@
       let             { L $$ LET }
       loop            { L $$ LOOP }
       in              { L $$ IN }
+      match           { L $$ MATCH }
+      case            { L $$ CASE }
 
       id              { L _ (ID _) }
       'id['           { L _ (INDEXING _) }
@@ -67,6 +69,11 @@
       unop            { L _ (UNOP _) }
       qunop           { L _ (QUALUNOP _ _) }
 
+      constructor     { L _ (CONSTRUCTOR _) }
+
+      '.field'        { L _ (PROJ_FIELD _) }
+      '.['            { L _ PROJ_INDEX }
+
       intlit          { L _ (INTLIT _) }
       i8lit           { L _ (I8LIT _) }
       i16lit          { L _ (I16LIT _) }
@@ -82,7 +89,6 @@
       stringlit       { L _ (STRINGLIT _) }
       charlit         { L _ (CHARLIT _) }
 
-      '#'             { L $$ HASH }
       '..'            { L $$ TWO_DOTS }
       '...'           { L $$ THREE_DOTS }
       '..<'           { L $$ TWO_DOTS_LT }
@@ -93,6 +99,7 @@
       '-'             { L $$ NEGATE }
       '<'             { L $$ LTH }
       '^'             { L $$ HAT }
+      '|'             { L $$ PIPE  }
 
       '+...'          { L _ (SYMBOL Plus _ _) }
       '-...'          { L _ (SYMBOL Minus _ _) }
@@ -133,9 +140,7 @@
       '`'             { L $$ BACKTICK }
       entry           { L $$ ENTRY }
       '->'            { L $$ RIGHT_ARROW }
-      '<-'            { L $$ LEFT_ARROW }
       ':'             { L $$ COLON }
-      '.'             { L $$ DOT }
       for             { L $$ FOR }
       do              { L $$ DO }
       with            { L $$ WITH }
@@ -154,20 +159,20 @@
       doc             { L _  (DOC _) }
 
 %left bottom
-%left ifprec letprec unsafe
-%left ','
+%left ifprec letprec unsafe caseprec typeprec enumprec
+%left ',' case
 %left ':'
 %right '...' '..<' '..>' '..'
 %left '`'
 %right '->'
 %left with
-%left '=' '<-'
+%left '='
 %left '|>...'
 %right '<|...'
 %left '||...'
 %left '&&...'
 %left '<=...' '>=...' '>...' '<' '<...' '==...' '!=...'
-%left '&...' '^...' '^' '|...'
+%left '&...' '^...' '^' '|...' '|'
 %left '<<...' '>>...'
 %left '+...' '-...' '-'
 %left '*...' '*' '/...' '%...' '//...' '%%...'
@@ -181,7 +186,7 @@
 Doc :: { DocComment }
      : doc { let L loc (DOC s) = $1 in DocComment s loc }
 
--- Three cases to avoid ambiguities.
+-- Four cases to avoid ambiguities.
 Prog :: { UncheckedProg }
       -- File begins with a file comment, followed by a Dec with a comment.
       : Doc Doc Dec_ Decs { Prog (Just $1) (addDoc $2 $3 : $4) }
@@ -189,6 +194,8 @@
       | Doc Dec_ Decs     { Prog (Just $1) ($2 : $3) }
       -- File begins with a dec with no comment.
       | Dec_ Decs         { Prog Nothing ($1 : $2) }
+      -- File is empty.
+      |                   { Prog Nothing [] }
 ;
 
 Dec :: { UncheckedDec }
@@ -204,10 +211,9 @@
     | TypeAbbr          { TypeDec $1 }
     | SigBind           { SigDec $1 }
     | ModBind           { ModDec $1 }
-    | open ModExp
-      { OpenDec $2 NoInfo $1 }
+    | open ModExp       { OpenDec $2 $1 }
     | import stringlit
-      { let L loc (STRINGLIT s) = $2 in LocalDec (OpenDec (ModImport s NoInfo loc) NoInfo $1) (srcspan $1 $>) }
+      { let L _ (STRINGLIT s) = $2 in ImportDec s NoInfo (srcspan $1 $>) }
     | local Dec         { LocalDec $2 (srcspan $1 $>) }
 ;
 
@@ -347,6 +353,7 @@
       | '^'        { qualName (nameFromString "^") }
       | '&...'     { binOpName $1 }
       | '|...'     { binOpName $1 }
+      | '|'        { qualName (nameFromString "|") }
       | '>>...'    { binOpName $1 }
       | '<<...'    { binOpName $1 }
       | '<|...'    { binOpName $1 }
@@ -408,8 +415,7 @@
            { let L _ (ID v) = $2 in TEArrow (Just v) $4 $7 (srcspan $1 $>) }
          | TypeExpTerm '->' TypeExp
            { TEArrow Nothing $1 $3 (srcspan $1 $>) }
-         | TypeExpTerm { $1 }
-
+         | TypeExpTerm %prec typeprec { $1 }
 
 TypeExpTerm :: { UncheckedTypeExp }
          : '*' TypeExpTerm
@@ -446,7 +452,17 @@
              | '{' '}'                        { TERecord [] (srcspan $1 $>) }
              | '{' FieldTypes1 '}'            { TERecord $2 (srcspan $1 $>) }
              | QualName                       { TEVar (fst $1) (snd $1) }
+             | Enum                           { TEEnum (fst $1)  (snd $1)}
 
+Enum :: { ([Name], SrcLoc) }
+      : VConstr0 %prec enumprec { ([fst $1], snd $1) }
+      | VConstr0 '|' Enum
+        { let names = fst $1 : fst $3; loc = srcspan (snd $1) (snd $3)
+          in (names, loc) }
+
+VConstr0 :: { (Name, SrcLoc) }
+          : constructor { let L _ (CONSTRUCTOR c) = $1 in (c, srclocOf $1) }
+
 TypeArg :: { TypeArgExp Name }
          : '[' DimDecl ']' { TypeArgExpDim (fst $2) (srcspan $1 $>) }
          | '[' ']'         { TypeArgExpDim AnyDim (srcspan $1 $>) }
@@ -470,13 +486,6 @@
           { let L loc (INTLIT n) = $1
             in (ConstDim (fromIntegral n), loc) }
 
-        -- Errors
-        | '#' {% parseErrorAt (srclocOf $1) $ Just $
-                unlines ["found implicit size quantification.",
-                         "This is no longer supported.  Use explicit size parameters."]
-              }
-
-
 FunParam :: { PatternBase NoInfo Name }
 FunParam : InnerPattern { $1 }
 
@@ -515,6 +524,8 @@
 
      | LetExp %prec letprec { $1 }
 
+     | MatchExp { $1 }
+
      | unsafe Exp2     { Unsafe $2 (srcspan $1 $>) }
      | assert Atom Atom    { Assert $2 $3 NoInfo (srcspan $1 $>) }
 
@@ -532,6 +543,7 @@
      | Exp2 '<<...' Exp2   { binOp $1 $2 $3 }
      | Exp2 '&...' Exp2    { binOp $1 $2 $3 }
      | Exp2 '|...' Exp2    { binOp $1 $2 $3 }
+     | Exp2 '|' Exp2       { binOp $1 (L $2 (SYMBOL Bor [] (nameFromString "|"))) $3 }
      | Exp2 '&&...' Exp2   { binOp $1 $2 $3 }
      | Exp2 '||...' Exp2   { binOp $1 $2 $3 }
      | Exp2 '^...' Exp2    { binOp $1 $2 $3 }
@@ -565,11 +577,6 @@
      | Exp2 with FieldAccesses_ '=' Exp2
        { RecordUpdate $1 (map fst $3) $5 NoInfo (srcspan $1 $>) }
 
-     | Exp2 with FieldAccesses_ '<-' Exp2
-       { RecordUpdate $1 (map fst $3) $5 NoInfo (srcspan $1 $>) }
-     | Exp2 with '[' DimIndices ']' '<-' Exp2
-       { Update $1 $4 $7 (srcspan $1 $>) }
-
      | '\\' TypeParams FunParams1 maybeAscription(TypeExpTerm) '->' Exp
        { Lambda $2 (fst $3 : snd $3) $6 (fmap (flip TypeDecl NoInfo) $4) NoInfo (srcspan $1 $>) }
 
@@ -585,6 +592,7 @@
 
 Atom :: { UncheckedExp }
 Atom : PrimLit        { Literal (fst $1) (snd $1) }
+     | VConstr0       { VConstr0 (fst $1) NoInfo (snd $1) }
      | intlit         { let L loc (INTLIT x) = $1 in IntLit x NoInfo loc }
      | floatlit       { let L loc (FLOATLIT x) = $1 in FloatLit x NoInfo loc }
      | stringlit      { let L loc (STRINGLIT s) = $1 in
@@ -628,8 +636,8 @@
      | '(' FieldAccess FieldAccesses ')'
        { ProjectSection (map fst ($2:$3)) NoInfo (srcspan $1 $>) }
 
-     | '(' '.' '[' DimIndices ']' ')'
-       { IndexSection $4 NoInfo (srcspan $1 $>) }
+     | '(' '.[' DimIndices ']' ')'
+       { IndexSection $3 NoInfo (srcspan $1 $>) }
 
 
 PrimLit :: { (PrimValue, SrcLoc) }
@@ -662,7 +670,7 @@
         | Exp            { ([], $1) }
 
 FieldAccess :: { (Name, SrcLoc) }
-             : '.' FieldId { (fst $2, srcspan $1 (snd $>)) }
+             : '.field' { let L loc (PROJ_FIELD f) = $1 in (f, loc) }
 
 FieldAccesses :: { [(Name, SrcLoc)] }
                : FieldAccess FieldAccesses { $1 : $2 }
@@ -700,6 +708,61 @@
 LetBody :: { UncheckedExp }
     : in Exp %prec letprec { $2 }
     | LetExp %prec letprec { $1 }
+
+MatchExp :: { UncheckedExp }
+          : match Exp Cases  { let loc = srcspan $1 $>
+                               in Match $2 $> NoInfo loc  }
+
+Cases :: { [CaseBase NoInfo Name] }
+       : Case  %prec caseprec { [$1] }
+       | Case Cases           { $1 : $2 }
+
+Case :: { CaseBase NoInfo Name }
+      : case CPattern '->' Exp       { let loc = srcspan $1 $>
+                                       in CasePat $2 $> loc }
+
+CPattern :: { PatternBase NoInfo Name }
+          : CInnerPattern ':' TypeExpDecl { PatternAscription $1 $3 (srcspan $1 $>) }
+          | CInnerPattern                 { $1 }
+
+CPatterns1 :: { [PatternBase NoInfo Name] }
+           : CPattern               { [$1] }
+           | CPattern ',' CPatterns1 { $1 : $3 }
+
+CInnerPattern :: { PatternBase NoInfo Name }
+               : id                                 { let L loc (ID name) = $1 in Id name NoInfo loc }
+               | '(' BindingBinOp ')'               { Id $2 NoInfo (srcspan $1 $>) }
+               | '(' BindingUnOp ')'                { Id $2 NoInfo (srcspan $1 $>) }
+               | '_'                                { Wildcard NoInfo $1 }
+               | '(' ')'                            { TuplePattern [] (srcspan $1 $>) }
+               | '(' CPattern ')'                   { PatternParens $2 (srcspan $1 $>) }
+               | '(' CPattern ',' CPatterns1 ')'    { TuplePattern ($2:$4) (srcspan $1 $>) }
+               | '{' CFieldPatterns '}'             { RecordPattern $2 (srcspan $1 $>) }
+               | CaseLiteral                        { PatternLit (fst $1) NoInfo (snd $1) }
+
+CFieldPattern :: { (Name, PatternBase NoInfo Name) }
+               : FieldId '=' CPattern
+               { (fst $1, $3) }
+               | FieldId ':' TypeExpDecl
+               { (fst $1, PatternAscription (Id (fst $1) NoInfo (snd $1)) $3 (srcspan (snd $1) $>)) }
+               | FieldId
+               { (fst $1, Id (fst $1) NoInfo (snd $1)) }
+
+CFieldPatterns :: { [(Name, PatternBase NoInfo Name)] }
+                : CFieldPatterns1 { $1 }
+                |                { [] }
+
+CFieldPatterns1 :: { [(Name, PatternBase NoInfo Name)] }
+                 : CFieldPattern ',' CFieldPatterns1 { $1 : $3 }
+                 | CFieldPattern                    { [$1] }
+
+CaseLiteral :: { (UncheckedExp, SrcLoc) }
+             : PrimLit        { (Literal (fst $1) (snd $1), snd $1) }
+             | intlit         { let L loc (INTLIT x) = $1 in (IntLit x NoInfo loc, loc) }
+             | floatlit       { let L loc (FLOATLIT x) = $1 in (FloatLit x NoInfo loc, loc) }
+             | stringlit      { let L loc (STRINGLIT s) = $1 in
+                              (ArrayLit (map (flip Literal loc . SignedValue . Int32Value . fromIntegral . ord) s) NoInfo loc, loc) }
+             | VConstr0       { (VConstr0 (fst $1) NoInfo (snd $1), snd $1) }
 
 LoopForm :: { LoopFormBase NoInfo Name }
 LoopForm : for VarId '<' Exp
diff --git a/src/Language/Futhark/Pretty.hs b/src/Language/Futhark/Pretty.hs
--- a/src/Language/Futhark/Pretty.hs
+++ b/src/Language/Futhark/Pretty.hs
@@ -122,6 +122,8 @@
     | otherwise =
         braces (commasep $ map ppField $ M.toList fs)
     where ppField (name, t) = text (nameToString name) <> colon <+> ppr t
+  ppr (ArrayEnumElem cs _) =
+    cat $ punctuate (text " | ") $ map ((text "#" <>) . ppr) cs
 
 instance Pretty (ShapeDecl dim) => Pretty (TypeBase dim as) where
   ppr = pprPrec 0
@@ -140,6 +142,8 @@
     parens (pprName v <> colon <+> ppr t1) <+> text "->" <+> ppr t2
   pprPrec p (Arrow _ Nothing t1 t2) =
     parensIf (p > 0) $ pprPrec 1 t1 <+> text "->" <+> ppr t2
+  pprPrec _ (Enum cs) =
+    cat $ punctuate (text " | ") $ map ((text "#" <>) . ppr) cs
 
 instance Pretty (ShapeDecl dim) => Pretty (TypeArg dim as) where
   ppr (TypeArgDim d _) = ppr $ ShapeDecl [d]
@@ -156,6 +160,8 @@
   ppr (TEArrow (Just v) t1 t2 _) = parens v' <+> text "->" <+> ppr t2
     where v' = pprName v <> colon <+> ppr t1
   ppr (TEArrow Nothing t1 t2 _) = ppr t1 <+> text "->" <+> ppr t2
+  ppr (TEEnum cs _) =
+    cat $ punctuate (text " | ") $ map ((text "#" <>) . ppr) cs
 
 instance (Eq vn, IsName vn) => Pretty (TypeArgExp vn) where
   ppr (TypeArgExpDim d _) = ppr $ ShapeDecl [d]
@@ -315,11 +321,16 @@
     text "loop" <+> spread (map ppr tparams ++ [ppr pat]) <+>
     equals <+> ppr initexp <+> ppr form <+> text "do" </>
     indent 2 (ppr loopbody)
+  pprPrec _ (VConstr0 n _ _) = text "#" <> ppr n
+  pprPrec _ (Match e cs _ _) = text "match" <+> ppr e </> ppr cs
 
 instance (Eq vn, IsName vn, Annot f) => Pretty (FieldBase f vn) where
   ppr (RecordFieldExplicit name e _) = ppr name <> equals <> ppr e
   ppr (RecordFieldImplicit name _ _) = pprName name
 
+instance (Eq vn, IsName vn, Annot f) => Pretty (CaseBase f vn) where
+  ppr (CasePat p e _) = ppr p <+> text "->" <+> ppr e
+
 instance (Eq vn, IsName vn, Annot f) => Pretty (LoopFormBase f vn) where
   ppr (For i ubound) =
     text "for" <+> ppr i <+> text "<" <+> align (ppr ubound)
@@ -340,6 +351,7 @@
   ppr (Wildcard t _)            = case unAnnot t of
                                     Just t' -> parens $ text "_" <> colon <+> ppr t'
                                     Nothing -> text "_"
+  ppr (PatternLit e _ _)        = ppr e
 
 ppAscription :: (Eq vn, IsName vn, Annot f) => Maybe (TypeDeclBase f vn) -> Doc
 ppAscription Nothing  = mempty
@@ -349,12 +361,13 @@
   ppr = stack . punctuate line . map ppr . progDecs
 
 instance (Eq vn, IsName vn, Annot f) => Pretty (DecBase f vn) where
-  ppr (ValDec dec)     = ppr dec
-  ppr (TypeDec dec)    = ppr dec
-  ppr (SigDec sig)     = ppr sig
-  ppr (ModDec sd)      = ppr sd
-  ppr (OpenDec x _ _)  = text "open" <+> ppr x
-  ppr (LocalDec dec _) = text "local" <+> ppr dec
+  ppr (ValDec dec)      = ppr dec
+  ppr (TypeDec dec)     = ppr dec
+  ppr (SigDec sig)      = ppr sig
+  ppr (ModDec sd)       = ppr sd
+  ppr (OpenDec x _)     = text "open" <+> ppr x
+  ppr (LocalDec dec _)  = text "local" <+> ppr dec
+  ppr (ImportDec x _ _) = text "import" <+> ppr x
 
 instance (Eq vn, IsName vn, Annot f) => Pretty (ModExpBase f vn) where
   ppr (ModVar v _) = ppr v
diff --git a/src/Language/Futhark/Syntax.hs b/src/Language/Futhark/Syntax.hs
--- a/src/Language/Futhark/Syntax.hs
+++ b/src/Language/Futhark/Syntax.hs
@@ -51,6 +51,7 @@
   , DimIndexBase(..)
   , ExpBase(..)
   , FieldBase(..)
+  , CaseBase(..)
   , LoopFormBase (..)
   , PatternBase(..)
   , StreamForm(..)
@@ -96,6 +97,7 @@
 import qualified Data.Set                         as S
 import           Data.Traversable
 import qualified Data.Semigroup as Sem
+import           Data.List
 import           Prelude
 
 import           Futhark.Representation.Primitive (FloatType (..),
@@ -311,6 +313,7 @@
     ArrayPrimElem PrimType as
   | ArrayPolyElem TypeName [TypeArg dim as] as
   | ArrayRecordElem (M.Map Name (RecordArrayElemTypeBase dim as))
+  | ArrayEnumElem [Name] as
   deriving (Eq, Show)
 
 instance Bitraversable ArrayElemTypeBase where
@@ -320,6 +323,8 @@
     ArrayPolyElem t <$> traverse (bitraverse f g) args <*> g as
   bitraverse f g (ArrayRecordElem fs) =
     ArrayRecordElem <$> traverse (bitraverse f g) fs
+  bitraverse _ g (ArrayEnumElem cs as) =
+    ArrayEnumElem cs <$> g as
 
 instance Bifunctor ArrayElemTypeBase where
   bimap = bimapDefault
@@ -332,6 +337,7 @@
 -- '==', aliases are ignored, but dimensions much match.  Function
 -- parameter names are ignored.
 data TypeBase dim as = Prim PrimType
+                     | Enum [Name]
                      | Array (ArrayElemTypeBase dim as) (ShapeDecl dim) Uniqueness
                      | Record (M.Map Name (TypeBase dim as))
                      | TypeVar as Uniqueness TypeName [TypeArg dim as]
@@ -346,6 +352,7 @@
   Record x1 == Record x2 = x1 == x2
   TypeVar _ u1 x1 y1 == TypeVar _ u2 x2 y2 = u1 == u2 && x1 == x2 && y1 == y2
   Arrow _ _ x1 y1 == Arrow _ _ x2 y2 = x1 == x2 && y1 == y2
+  Enum ns1 == Enum ns2 = sort ns1 == sort ns2
   _ == _ = False
 
 instance Bitraversable TypeBase where
@@ -357,6 +364,7 @@
     TypeVar <$> g als <*> pure u <*> pure t <*> traverse (bitraverse f g) args
   bitraverse f g (Arrow als v t1 t2) =
     Arrow <$> g als <*> pure v <*> bitraverse f g t1 <*> bitraverse f g t2
+  bitraverse _ _ (Enum n) = pure $ Enum n
 
 instance Bifunctor TypeBase where
   bimap = bimapDefault
@@ -395,6 +403,7 @@
                 | TEUnique (TypeExp vn) SrcLoc
                 | TEApply (TypeExp vn) (TypeArgExp vn) SrcLoc
                 | TEArrow (Maybe vn) (TypeExp vn) (TypeExp vn) SrcLoc
+                | TEEnum [Name] SrcLoc
                  deriving (Eq, Show)
 
 instance Located (TypeExp vn) where
@@ -405,6 +414,7 @@
   locOf (TEUnique _ loc)    = locOf loc
   locOf (TEApply _ _ loc)   = locOf loc
   locOf (TEArrow _ _ _ loc) = locOf loc
+  locOf (TEEnum _ loc)    = locOf loc
 
 data TypeArgExp vn = TypeArgExpDim (DimDecl vn) SrcLoc
                    | TypeArgExpType (TypeExp vn)
@@ -709,6 +719,12 @@
             -- and return the value of the second expression if it
             -- does.
 
+            | VConstr0 Name (f CompType) SrcLoc
+            -- ^ An enum element, e.g., @#foo@.
+
+            | Match (ExpBase f vn) [CaseBase f vn] (f CompType) SrcLoc
+            -- ^ A match expression.
+
 deriving instance Showable f vn => Show (ExpBase f vn)
 
 data StreamForm f vn = MapLike    StreamOrd
@@ -756,6 +772,8 @@
   locOf (Stream _ _ _  pos)            = locOf pos
   locOf (Unsafe _ loc)                 = locOf loc
   locOf (Assert _ _ _ loc)             = locOf loc
+  locOf (VConstr0 _ _ loc)             = locOf loc
+  locOf (Match _ _ _ loc)                = locOf loc
 
 -- | An entry in a record literal.
 data FieldBase f vn = RecordFieldExplicit Name (ExpBase f vn) SrcLoc
@@ -767,6 +785,14 @@
   locOf (RecordFieldExplicit _ _ loc) = locOf loc
   locOf (RecordFieldImplicit _ _ loc) = locOf loc
 
+-- | A case in a match expression.
+data CaseBase f vn = CasePat (PatternBase f vn) (ExpBase f vn) SrcLoc
+
+deriving instance Showable f vn => Show (CaseBase f vn)
+
+instance Located (CaseBase f vn) where
+  locOf (CasePat _ _ loc) = locOf loc
+
 -- | Whether the loop is a @for@-loop or a @while@-loop.
 data LoopFormBase f vn = For (IdentBase f vn) (ExpBase f vn)
                        | ForIn (PatternBase f vn) (ExpBase f vn)
@@ -781,6 +807,7 @@
                       | Id vn (f PatternType) SrcLoc
                       | Wildcard (f PatternType) SrcLoc -- Nothing, i.e. underscore.
                       | PatternAscription (PatternBase f vn) (TypeDeclBase f vn) SrcLoc
+                      | PatternLit (ExpBase f vn) (f PatternType) SrcLoc
 deriving instance Showable f vn => Show (PatternBase f vn)
 
 instance Located (PatternBase f vn) where
@@ -790,6 +817,7 @@
   locOf (Id _ _ loc)                = locOf loc
   locOf (Wildcard _ loc)            = locOf loc
   locOf (PatternAscription _ _ loc) = locOf loc
+  locOf (PatternLit _ _ loc)        = locOf loc
 
 -- | Documentation strings, including source location.
 data DocComment = DocComment String SrcLoc
@@ -958,17 +986,19 @@
                   | TypeDec (TypeBindBase f vn)
                   | SigDec (SigBindBase f vn)
                   | ModDec (ModBindBase f vn)
-                  | OpenDec (ModExpBase f vn) (f [VName]) SrcLoc
+                  | OpenDec (ModExpBase f vn) SrcLoc
                   | LocalDec (DecBase f vn) SrcLoc
+                  | ImportDec FilePath (f FilePath) SrcLoc
 deriving instance Showable f vn => Show (DecBase f vn)
 
 instance Located (DecBase f vn) where
-  locOf (ValDec d)        = locOf d
-  locOf (TypeDec d)       = locOf d
-  locOf (SigDec d)        = locOf d
-  locOf (ModDec d)        = locOf d
-  locOf (OpenDec _ _ loc) = locOf loc
-  locOf (LocalDec _ loc)  = locOf loc
+  locOf (ValDec d)          = locOf d
+  locOf (TypeDec d)         = locOf d
+  locOf (SigDec d)          = locOf d
+  locOf (ModDec d)          = locOf d
+  locOf (OpenDec _ loc)     = locOf loc
+  locOf (LocalDec _ loc)    = locOf loc
+  locOf (ImportDec _ _ loc) = locOf loc
 
 -- | The program described by a single Futhark file.  May depend on
 -- other files.
diff --git a/src/Language/Futhark/Traversals.hs b/src/Language/Futhark/Traversals.hs
--- a/src/Language/Futhark/Traversals.hs
+++ b/src/Language/Futhark/Traversals.hs
@@ -176,6 +176,11 @@
     DoLoop <$> mapM (astMap tv) tparams <*> astMap tv mergepat <*>
     mapOnExp tv mergeexp <*> astMap tv form <*>
     mapOnExp tv loopbody <*> pure loc
+  astMap tv (VConstr0 name t loc) =
+    VConstr0 name <$> traverse (mapOnCompType tv) t <*> pure loc
+  astMap tv (Match e cases t loc) =
+    Match <$> mapOnExp tv e <*> astMap tv cases
+          <*> traverse (mapOnCompType tv) t <*> pure loc
 
 instance ASTMappable (LoopFormBase Info VName) where
   astMap tv (For i bound) = For <$> astMap tv i <*> astMap tv bound
@@ -194,6 +199,7 @@
     TEApply <$> astMap tv t1 <*> astMap tv t2 <*> pure loc
   astMap tv (TEArrow v t1 t2 loc) =
     TEArrow v <$> astMap tv t1 <*> astMap tv t2 <*> pure loc
+  astMap _ te@TEEnum{} = pure te
 
 instance ASTMappable (TypeArgExp VName) where
   astMap tv (TypeArgExpDim dim loc) =
@@ -234,6 +240,7 @@
   TypeVar <$> h als <*> pure u <*> f t <*> traverse (traverseTypeArg f g h) args
 traverseType f g h (Arrow als v t1 t2) =
   Arrow <$> h als <*> pure v <*> traverseType f g h t1 <*> traverseType f g h t2
+traverseType _ _ _ (Enum cs) = pure $ Enum cs
 
 traverseArrayElemType :: Applicative f =>
                          TypeTraverser f ArrayElemTypeBase dim1 als1 dim2 als2
@@ -243,6 +250,8 @@
   ArrayPolyElem <$> f t <*> traverse (traverseTypeArg f g h) args <*> h as
 traverseArrayElemType f g h (ArrayRecordElem fs) =
   ArrayRecordElem <$> traverse (traverseRecordArrayElemType f g h) fs
+traverseArrayElemType _ _ h (ArrayEnumElem cs as) =
+  ArrayEnumElem cs <$> h as
 
 traverseRecordArrayElemType :: Applicative f =>
                                TypeTraverser f RecordArrayElemTypeBase dim1 als1 dim2 als2
@@ -294,6 +303,8 @@
     PatternAscription <$> astMap tv pat <*> astMap tv t <*> pure loc
   astMap tv (Wildcard (Info t) loc) =
     Wildcard <$> (Info <$> mapOnPatternType tv t) <*> pure loc
+  astMap tv (PatternLit e (Info t) loc) =
+    PatternLit <$> astMap tv e <*> (Info <$> mapOnPatternType tv t) <*>  pure loc
 
 instance ASTMappable (FieldBase Info VName) where
   astMap tv (RecordFieldExplicit name e loc) =
@@ -301,6 +312,10 @@
   astMap tv (RecordFieldImplicit name t loc) =
     RecordFieldImplicit <$> mapOnName tv name
     <*> traverse (mapOnCompType tv) t <*> pure loc
+
+instance ASTMappable (CaseBase Info VName) where
+  astMap tv (CasePat pat e loc) =
+    CasePat <$> astMap tv pat <*> astMap tv e <*> pure loc
 
 instance ASTMappable a => ASTMappable (Info a) where
   astMap tv = traverse $ astMap tv
diff --git a/src/Language/Futhark/TypeChecker.hs b/src/Language/Futhark/TypeChecker.hs
--- a/src/Language/Futhark/TypeChecker.hs
+++ b/src/Language/Futhark/TypeChecker.hs
@@ -52,15 +52,16 @@
 
 -- | Type check a single expression containing no type information,
 -- yielding either a type error or the same expression annotated with
--- type information.  See also 'checkProg'.
+-- type information.  Also returns a list of type parameters, which
+-- will be nonempty if the expression is polymorphic.  See also
+-- 'checkProg'.
 checkExp :: Imports
          -> VNameSource
          -> Env
          -> UncheckedExp
-         -> Either TypeError Exp
+         -> Either TypeError ([TypeParam], Exp)
 checkExp files src env e = do
-  (e', _, _) <- runTypeM env files' (mkInitialImport "") src $
-    checkOneExp e
+  (e', _, _) <- runTypeM env files' (mkInitialImport "") src $ checkOneExp e
   return e'
   where files' = M.map fileEnv $ M.fromList files
 
@@ -138,8 +139,8 @@
           check Term name loc
 
         f OpenDec{} = return
-
         f LocalDec{} = return
+        f ImportDec{} = return
 
 bindingTypeParams :: [TypeParam] -> TypeM a -> TypeM a
 bindingTypeParams tparams = localEnv env
@@ -447,15 +448,21 @@
   when (entry && any isTypeParam tparams') $
     throwError $ TypeError loc "Entry point functions may not be polymorphic."
 
-  when (entry && singleTuplePattern params') $
-    warn loc "This entry point accepts a *single* tuple-typed parameter, *not* multiple parameters.\nThis will be an error in the future."
-
   let (rettype_params, rettype') = unfoldFunType rettype
   when (entry && (any (not . patternOrderZero) params' ||
                   any (not . orderZero) rettype_params ||
                   not (orderZero rettype'))) $
     throwError $ TypeError loc "Entry point functions may not be higher-order."
 
+  case (entry, filter nastyParameter params') of
+    (True, p : _) -> warn loc $ "Entry point parameter\n\n  " <>
+                     pretty p <> "\n\nwill have an opaque type, so the entry point will likely not be callable."
+    _ -> return ()
+
+  when (entry && nastyReturnType maybe_tdecl' rettype) $
+    warn loc $ "Entry point return type\n\n  " <>
+    pretty rettype <> "\n\nwill have an opaque type, so the result will likely not be usable."
+
   return (mempty { envVtable =
                      M.singleton fname' $
                      BoundV tparams' $ foldr (uncurry (Arrow ()) . patternParam) rettype params'
@@ -464,10 +471,37 @@
                  },
            ValBind entry fname' maybe_tdecl' (Info rettype) tparams' params' body' doc loc)
 
-singleTuplePattern :: [Pattern] -> Bool
-singleTuplePattern [TuplePattern _ _] = True
-singleTuplePattern _                  = False
+nastyType :: Monoid als => TypeBase dim als -> Bool
+nastyType Prim{} = False
+nastyType t@Array{} = nastyType $ stripArray 1 t
+nastyType _ = True
 
+nastyReturnType :: Monoid als => Maybe (TypeExp VName) -> TypeBase dim als -> Bool
+nastyReturnType _ (Arrow _ _ t1 t2) =
+  nastyType t1 || nastyReturnType Nothing t2
+nastyReturnType (Just te) _
+  | niceTypeExp te = False
+nastyReturnType te t
+  | Just ts <- isTupleRecord t =
+      case te of
+        Just (TETuple tes _) -> or $ zipWith nastyType' (map Just tes) ts
+        _ -> any nastyType ts
+  | otherwise = nastyType' te t
+  where nastyType' (Just te') _ | niceTypeExp te' = False
+        nastyType' _ t' = nastyType t'
+
+nastyParameter :: Pattern -> Bool
+nastyParameter p = nastyType (patternType p) && not (ascripted p)
+  where ascripted (PatternAscription _ (TypeDecl te _) _) = niceTypeExp te
+        ascripted (PatternParens p' _) = ascripted p'
+        ascripted _ = False
+
+niceTypeExp :: TypeExp VName -> Bool
+niceTypeExp (TEVar (QualName [] _) _) = True
+niceTypeExp (TEApply te TypeArgExpDim{} _) = niceTypeExp te
+niceTypeExp (TEArray te _ _) = niceTypeExp te
+niceTypeExp _ = False
+
 checkOneDec :: DecBase NoInfo Name -> TypeM (TySet, Env, DecBase Info VName)
 checkOneDec (ModDec struct) = do
   (abs, modenv, struct') <- checkModBind struct
@@ -481,17 +515,20 @@
   (tenv, tdec') <- checkTypeBind tdec
   return (mempty, tenv, TypeDec tdec')
 
-checkOneDec (OpenDec x NoInfo loc) = do
+checkOneDec (OpenDec x loc) = do
   (x_abs, x_env, x') <- checkModExpToEnv x
-  let names = S.toList $ allNamesInEnv x_env
-  return (x_abs,
-          x_env,
-          OpenDec x' (Info names) loc)
+  return (x_abs, x_env, OpenDec x' loc)
 
 checkOneDec (LocalDec d loc) = do
   (abstypes, env, d') <- checkOneDec d
   return (abstypes, env, LocalDec d' loc)
 
+checkOneDec (ImportDec name NoInfo loc) = do
+  (name', env) <- lookupImport loc name
+  when ("/futlib" `isPrefixOf` name) $
+    warn loc $ name ++ " is already implicitly imported."
+  return (mempty, env, ImportDec name (Info name') loc)
+
 checkOneDec (ValDec vb) = do
   (env, vb') <- checkValBind vb
   return (mempty, env, ValDec vb')
@@ -828,6 +865,8 @@
           Prim t
         substituteInType (Record ts) =
           Record $ fmap substituteInType ts
+        substituteInType (Enum cs) =
+          Enum cs
         substituteInType (Array (ArrayPrimElem t ()) shape u) =
           Array (ArrayPrimElem t ()) (substituteInShape shape) u
         substituteInType (Array (ArrayPolyElem (TypeName qs v) targs ()) shape u) =
@@ -840,6 +879,8 @@
           in case arrayOf (Record ts') (substituteInShape shape) u of
             Just t' -> t'
             _ -> error "substituteInType: Cannot create array after substitution."
+        substituteInType (Array (ArrayEnumElem cs ()) shape u) =
+          Array (ArrayEnumElem cs ()) (substituteInShape shape) u
         substituteInType (Arrow als v t1 t2) =
           Arrow als v (substituteInType t1) (substituteInType t2)
 
diff --git a/src/Language/Futhark/TypeChecker/Terms.hs b/src/Language/Futhark/TypeChecker/Terms.hs
--- a/src/Language/Futhark/TypeChecker/Terms.hs
+++ b/src/Language/Futhark/TypeChecker/Terms.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances, DeriveFunctor #-}
 -- | Facilities for type-checking Futhark terms.  Checking a term
 -- requires a little more context to track uniqueness and such.
 --
@@ -17,6 +18,7 @@
 import Control.Monad.State
 import Control.Monad.RWS
 import qualified Control.Monad.Fail as Fail
+import Data.Char (isAlpha)
 import Data.List
 import Data.Loc
 import Data.Maybe
@@ -33,7 +35,7 @@
 import Language.Futhark.TypeChecker.Unify
 import qualified Language.Futhark.TypeChecker.Types as Types
 import qualified Language.Futhark.TypeChecker.Monad as TypeM
-import Futhark.Util.Pretty (Pretty)
+import Futhark.Util.Pretty hiding (space, bool)
 
 --- Uniqueness
 
@@ -203,7 +205,7 @@
 
   newTypeVar loc desc = do
     i <- incCounter
-    v <- newID $ nameFromString $ desc ++ show i
+    v <- newID $ mkTypeVarName desc i
     modifyConstraints $ M.insert v $ NoConstraint Nothing loc
     return $ TypeVar mempty Nonunique (typeName v) []
 
@@ -368,7 +370,7 @@
       tnames = map typeParamName tparams'
   (fresh_tnames, inst_list) <- unzip <$> mapM (instantiateTypeParam loc) tparams'
   let substs = M.fromList $ zip tnames $
-               map vacuousShapeAnnotations inst_list
+               map (Subst . vacuousShapeAnnotations) inst_list
       t' = substTypesAny (`M.lookup` substs) t
   return (fresh_tnames, t')
 
@@ -377,7 +379,7 @@
 instantiateTypeParam :: Monoid as => SrcLoc -> TypeParam -> TermTypeM (VName, TypeBase dim as)
 instantiateTypeParam loc tparam = do
   i <- incCounter
-  v <- newID $ nameFromString $ baseString (typeParamName tparam) ++ show i
+  v <- newID $ mkTypeVarName (takeWhile isAlpha (baseString (typeParamName tparam))) i
   modifyConstraints $ M.insert v $ NoConstraint (Just l) loc
   return (v, TypeVar mempty Nonunique (typeName v) [])
   where l = case tparam of TypeParamType x _ _ -> x
@@ -396,8 +398,7 @@
 useAfterConsume :: MonadTypeChecker m => Name -> SrcLoc -> SrcLoc -> m a
 useAfterConsume name rloc wloc =
   throwError $ TypeError rloc $
-  "Variable " ++ pretty name ++ " used," ++
-  "but previously consumed at " ++ locStr wloc ++ ".  (Possibly through aliasing)"
+  "Variable " ++ pretty name ++ " previously consumed at " ++ locStr wloc ++ ".  (Possibly through aliasing)"
 
 consumeAfterConsume :: MonadTypeChecker m => Name -> SrcLoc -> SrcLoc -> m a
 consumeAfterConsume name loc1 loc2 =
@@ -544,6 +545,17 @@
       pure (TypeDecl t' (Info st)) <*> pure loc
  where unifyUniqueness u1 u2 = if u2 `subuniqueOf` u1 then Just u1 else Nothing
 
+checkPattern' (PatternLit e NoInfo loc) (Ascribed t) = do
+  e' <- checkExp e
+  t' <- expType e'
+  unify loc (toStructural t') (toStructural t)
+  return $ PatternLit e' (Info (vacuousShapeAnnotations t')) loc
+
+checkPattern' (PatternLit e NoInfo loc) NoneInferred = do
+  e' <- checkExp e
+  t' <- expType e'
+  return $ PatternLit e' (Info (vacuousShapeAnnotations t')) loc
+
 bindPatternNames :: PatternBase NoInfo Name -> TermTypeM a -> TermTypeM a
 bindPatternNames = bindSpaced . map asTerm . S.toList . patIdentSet
   where asTerm v = (Term, identName v)
@@ -695,6 +707,7 @@
 patternUses :: Pattern -> ([VName], [VName])
 patternUses Id{} = mempty
 patternUses Wildcard{} = mempty
+patternUses PatternLit{} = mempty
 patternUses (PatternParens p _) = patternUses p
 patternUses (TuplePattern ps _) = foldMap patternUses ps
 patternUses (RecordPattern fs _) = foldMap (patternUses . snd) fs
@@ -709,6 +722,7 @@
         typeExpUses (TEArrow _ t1 t2 _) =
           let (pos, neg) = typeExpUses t1 <> typeExpUses t2
           in (mempty, pos <> neg)
+        typeExpUses TEEnum{} = mempty
         typeArgUses (TypeArgExpDim d _) = dimDeclUses d
         typeArgUses (TypeArgExpType te) = typeExpUses te
 
@@ -1226,6 +1240,7 @@
             RecordPattern (map (fmap uniquePat) fs) ploc
           uniquePat (PatternAscription p t ploc) =
             PatternAscription p t ploc
+          uniquePat p@PatternLit{} = p
 
           -- Make the pattern unique where needed.
           pat' = uniquePat pat
@@ -1271,6 +1286,176 @@
         then return pat'
         else convergePattern pat' body_cons' body_t' body_loc
 
+checkExp (VConstr0 name NoInfo loc) = do
+  t <- newTypeVar loc "t"
+  mustHaveConstr loc name t
+  return $ VConstr0 name (Info t) loc
+
+checkExp (Match _ [] NoInfo loc) =
+  typeError loc "Match expressions must have at least one case."
+
+checkExp (Match e (c:cs) NoInfo loc) =
+  sequentially (checkExp e) $ \e' _ -> do
+    mt <- expType e'
+    (cs', t) <- checkCases mt c cs
+    zeroOrderType loc "returned from pattern match" t
+    return $ Match e' cs' (Info t) loc
+
+checkCases :: CompType
+           -> CaseBase NoInfo Name
+           -> [CaseBase NoInfo Name]
+           -> TermTypeM ([CaseBase Info VName], CompType)
+checkCases mt c [] = do
+  (c', t) <- checkCase mt c
+  return ([c'], t)
+checkCases mt c (c2:cs) = do
+  (((c', c_t), (cs', cs_t)), dflow) <-
+    tapOccurences $ checkCase mt c `alternative` checkCases mt c2 cs
+  unify (srclocOf c) (toStruct c_t) (toStruct cs_t)
+  let t = unifyTypeAliases c_t cs_t `addAliases` (`S.difference` allConsumed dflow)
+  return (c':cs', t)
+
+checkCase :: CompType -> CaseBase NoInfo Name
+          -> TermTypeM (CaseBase Info VName, CompType)
+checkCase mt (CasePat p caseExp loc) =
+  bindingPattern [] p (Ascribed $ vacuousShapeAnnotations mt) $ \_ p' -> do
+    caseExp' <- checkExp caseExp
+    caseType <- expType caseExp'
+    return (CasePat p' caseExp' loc, caseType)
+
+-- | An unmatched pattern. Used in in the generation of
+-- unmatched pattern warnings by the type checker.
+data Unmatched p = UnmatchedNum p [ExpBase Info VName]
+                 | UnmatchedBool p
+                 | UnmatchedEnum p
+                 | Unmatched p
+                 deriving (Functor, Show)
+
+instance Pretty (Unmatched (PatternBase Info VName)) where
+  ppr um = case um of
+      (UnmatchedNum p nums) -> ppr' p <+> text "where p is not one of" <+> ppr nums
+      (UnmatchedBool p)     -> ppr' p
+      (UnmatchedEnum p)     -> ppr' p
+      (Unmatched p)         -> ppr' p
+    where
+      ppr' (PatternAscription p t _) = ppr p <> text ":" <+> ppr t
+      ppr' (PatternParens p _)       = parens $ ppr' p
+      ppr' (Id v _ _)                = pprName v
+      ppr' (TuplePattern pats _)     = parens $ commasep $ map ppr' pats
+      ppr' (RecordPattern fs _)      = braces $ commasep $ map ppField fs
+        where ppField (name, t)      = text (nameToString name) <> equals <> ppr' t
+      ppr' Wildcard{}                = text "_"
+      ppr' (PatternLit e _ _)        = ppr e
+
+unpackPat :: Pattern -> [Maybe Pattern]
+unpackPat Wildcard{} = [Nothing]
+unpackPat (PatternParens p _) = unpackPat p
+unpackPat Id{} = [Nothing]
+unpackPat (TuplePattern ps _) = Just <$> ps
+unpackPat (RecordPattern fs _) = Just . snd <$> sortFields (M.fromList fs)
+unpackPat (PatternAscription p _ _) = unpackPat p
+unpackPat p@PatternLit{} = [Just p]
+
+wildPattern :: Pattern -> Int -> Unmatched Pattern -> Unmatched Pattern
+wildPattern (TuplePattern ps loc) pos um = f <$> um
+  where f p = TuplePattern (take (pos - 1) ps' ++ [p] ++ drop pos ps') loc
+        ps' = map wildOut ps
+        wildOut p = Wildcard (Info (patternPatternType p)) (srclocOf p)
+wildPattern (RecordPattern fs loc) pos um = wildRecord <$> um
+    where wildRecord p =
+            RecordPattern (take (pos - 1) fs' ++ [(fst (fs!!(pos - 1)), p)] ++ drop pos fs') loc
+          fs' = map wildOut fs
+          wildOut (f,p) = (f, Wildcard (Info (patternPatternType p)) (srclocOf p))
+wildPattern (PatternAscription p _ _) pos um = wildPattern p pos um
+wildPattern (PatternParens p _) pos um = wildPattern p pos um
+wildPattern _ _ um = um
+
+checkUnmatched :: (MonadBreadCrumbs m, MonadTypeChecker m) => Exp -> m ()
+checkUnmatched e = void $ checkUnmatched' e >> astMap tv e
+  where checkUnmatched' (Match _ cs _ loc) =
+          let ps = map (\(CasePat p _ _) -> p) cs
+          in case unmatched id ps of
+              []  -> return ()
+              ps' -> typeError loc $ "Unmatched cases in match expression: \n"
+                                     ++ unlines (map (("  " ++) . pretty) ps')
+        checkUnmatched' _ = return ()
+        tv = ASTMapper { mapOnExp =
+                           \e' -> checkUnmatched' e' >> return e'
+                       , mapOnName        = pure
+                       , mapOnQualName    = pure
+                       , mapOnType        = pure
+                       , mapOnCompType    = pure
+                       , mapOnStructType  = pure
+                       , mapOnPatternType = pure
+                       }
+
+unmatched :: (Unmatched Pattern -> Unmatched Pattern) -> [Pattern] -> [Unmatched Pattern]
+unmatched hole (p:ps)
+  | sameStructure labeledCols = do
+    (i, cols) <- labeledCols
+    let hole' p' = hole $ wildPattern p i p'
+    case sequence cols of
+      Nothing      -> []
+      Just cs
+        | all isPatternLit cs  -> map hole' $ localUnmatched cs
+        | otherwise            -> unmatched hole' cs
+
+  where labeledCols = zip [1..] $ transpose $ map unpackPat (p:ps)
+
+        localUnmatched :: [Pattern] -> [Unmatched Pattern]
+        localUnmatched [] = []
+        localUnmatched ps'@(p':_) =
+          case vacuousShapeAnnotations $ patternType p'  of
+            Enum cs'' ->
+              let matched = nub $ mapMaybe (pExp >=> constr) ps'
+              in map (UnmatchedEnum . buildEnum (Enum cs'')) $ cs'' \\ matched
+            Prim t
+              | not (any idOrWild ps') ->
+                case t of
+                  Bool ->
+                    let matched = nub $ mapMaybe (pExp >=> bool) $ filter isPatternLit ps'
+                    in map (UnmatchedBool . buildBool (Prim t)) $ [True, False] \\ matched
+                  _ ->
+                    let matched = mapMaybe pExp $ filter isPatternLit ps'
+                    in [UnmatchedNum (buildId (Info (Prim t)) "p") matched]
+            _ -> []
+
+        sameStructure [] = True
+        sameStructure (x:xs) = all (\y -> length y == length x' ) xs'
+          where (x':xs') = map snd (x:xs)
+
+        pExp (PatternLit e' _ _) = Just e'
+        pExp _ = Nothing
+
+        constr (VConstr0 c _ _) = Just c
+        constr (Ascript e' _ _)  = constr e'
+        constr _ = Nothing
+
+        isPatternLit PatternLit{} = True
+        isPatternLit (PatternAscription p' _ _) = isPatternLit p'
+        isPatternLit (PatternParens p' _)  = isPatternLit p'
+        isPatternLit _ = False
+
+        idOrWild Id{} = True
+        idOrWild Wildcard{} = True
+        idOrWild (PatternAscription p' _ _) = idOrWild p'
+        idOrWild (PatternParens p' _) = idOrWild p'
+        idOrWild _ = False
+
+        bool (Literal (BoolValue b) _ ) = Just b
+        bool _ = Nothing
+
+        buildEnum t c =
+          PatternLit (VConstr0 c (Info t) noLoc) (Info (vacuousShapeAnnotations t)) noLoc
+        buildBool t b =
+          PatternLit (Literal (BoolValue b) noLoc) (Info (vacuousShapeAnnotations t)) noLoc
+        buildId t n =
+          -- The VName tag here will never be used since the value
+          -- exists exclusively for printing warnings.
+          Id (VName (nameFromString n) (-1)) t noLoc
+
+unmatched _ _ = []
+
 checkIdent :: IdentBase NoInfo Name -> TermTypeM Ident
 checkIdent (Ident name _ loc) = do
   (QualName _ name', vt) <- lookupVar loc (qualName name)
@@ -1364,11 +1549,14 @@
 consumeArg loc at Consume = return [consumption (aliases at) loc]
 consumeArg loc at _       = return [observation (aliases at) loc]
 
-checkOneExp :: UncheckedExp -> TypeM Exp
+checkOneExp :: UncheckedExp -> TypeM ([TypeParam], Exp)
 checkOneExp e = fmap fst . runTermTypeM $ do
   e' <- checkExp e
+  let t = vacuousShapeAnnotations $ toStruct $ typeOf e'
+  tparams <- letGeneralise [] [t] mempty
   fixOverloadedTypes
-  updateExpTypes e'
+  e'' <- updateExpTypes e'
+  return (tparams, e'')
 
 -- | Type-check a top-level (or module-level) function definition.
 checkFunDef :: (Name, Maybe UncheckedTypeExp,
@@ -1388,6 +1576,10 @@
   maybe_retdecl' <- traverse updateExpTypes maybe_retdecl
   rettype' <- normaliseType rettype
 
+  -- Check if pattern matches are exhaustive and yield
+  -- errors if not.
+  checkUnmatched body'
+
   return (fname, tparams, params', maybe_retdecl', rettype', body')
 
 -- | This is "fixing" as in "setting them", not "correcting them".  We
@@ -1420,6 +1612,11 @@
           where fs' = intercalate ", " $ map field $ M.toList fs
                 field (l, t) = pretty l ++ ": " ++ pretty t
 
+        fixOverloaded (_, HasConstrs cs loc) =
+          typeError loc $ unlines [ "Type is ambiguous (must be an enum with constructors: " ++ cs' ++ ")."
+                                    ,"Add a type annotation to disambiguate the type."]
+          where cs' = intercalate " | " $ map (\c -> '#' : pretty c) cs
+
         fixOverloaded _ = return ()
 
 checkFunDef' :: (Name, Maybe UncheckedTypeExp,
@@ -1449,32 +1646,7 @@
         return (Just retdecl', retdecl_type)
       Nothing -> return (Nothing, vacuousShapeAnnotations $ toStruct body_t)
 
-    -- Candidates for let-generalisation are those type variables that
-    ---
-    -- (1) were not known before we checked this function, and
-    --
-    -- (2) are not used in the (new) definition of any type variables
-    -- known before we checked this function.
-    --
-    -- (3) are not referenced from an overloaded type (for example,
-    -- are the element types of an incompletely resolved record type).
-    -- This is a bit more restrictive than I'd like, and SML for
-    -- example does not have this restriction.
-    now_substs <- getConstraints
-    let then_type_variables = S.fromList $ M.keys then_substs
-        then_type_constraints = constraintTypeVars $
-                                M.filterWithKey (\k _ -> k `S.member` then_type_variables) now_substs
-        keep_type_variables = then_type_variables <>
-                              then_type_constraints <>
-                              overloadedTypeVars now_substs
-
-    let new_substs = M.filterWithKey (\k _ -> not (k `S.member` keep_type_variables)) now_substs
-    tparams'' <- closeOverTypes new_substs tparams' $
-                 rettype : map patternStructType params''
-
-    -- We keep those type variables that were not closed over by
-    -- let-generalisation.
-    modifyConstraints $ M.filterWithKey $ \k _ -> k `notElem` map typeParamName tparams''
+    tparams'' <- letGeneralise tparams' (rettype : map patternStructType params'') then_substs
 
     bindSpaced [(Term, fname)] $ do
       fname' <- checkName Term fname loc
@@ -1510,6 +1682,39 @@
         returnAliasing (Record ets1) (Record ets2) =
           concat $ M.elems $ M.intersectionWith returnAliasing ets1 ets2
         returnAliasing expected got = [(uniqueness expected, aliases got)]
+
+letGeneralise :: [TypeParam]
+              -> [StructType]
+              -> Constraints
+              -> TermTypeM [TypeParam]
+letGeneralise tparams ts then_substs = do
+  now_substs <- getConstraints
+  -- Candidates for let-generalisation are those type variables that
+  --
+  -- (1) were not known before we checked this function, and
+  --
+  -- (2) are not used in the (new) definition of any type variables
+  -- known before we checked this function.
+  --
+  -- (3) are not referenced from an overloaded type (for example,
+  -- are the element types of an incompletely resolved record type).
+  -- This is a bit more restrictive than I'd like, and SML for
+  -- example does not have this restriction.
+  let then_type_variables = S.fromList $ M.keys then_substs
+      then_type_constraints = constraintTypeVars $
+                              M.filterWithKey (\k _ -> k `S.member` then_type_variables) now_substs
+      keep_type_variables = then_type_variables <>
+                            then_type_constraints <>
+                            overloadedTypeVars now_substs
+
+  let new_substs = M.filterWithKey (\k _ -> not (k `S.member` keep_type_variables)) now_substs
+  tparams' <- closeOverTypes new_substs tparams ts
+
+  -- We keep those type variables that were not closed over by
+  -- let-generalisation.
+  modifyConstraints $ M.filterWithKey $ \k _ -> k `notElem` map typeParamName tparams'
+
+  return tparams'
 
 checkFunBody :: ExpBase NoInfo Name
              -> Maybe StructType
diff --git a/src/Language/Futhark/TypeChecker/Types.hs b/src/Language/Futhark/TypeChecker/Types.hs
--- a/src/Language/Futhark/TypeChecker/Types.hs
+++ b/src/Language/Futhark/TypeChecker/Types.hs
@@ -15,6 +15,7 @@
   , substituteTypes
   , substituteTypesInBoundV
 
+  , Subst(..)
   , Substitutable(..)
   , substTypesAny
   )
@@ -58,6 +59,8 @@
       (M.intersectionWith (,) ts1 ts2)
 unifyTypesU uf (Arrow as1 mn1 t1 t1') (Arrow as2 _ t2 t2') =
   Arrow (as1 <> as2) mn1 <$> unifyTypesU (flip uf) t1 t2 <*> unifyTypesU uf t1' t2'
+unifyTypesU _ e1@Enum{} e2@Enum{}
+  | e1 == e2 = Just e1
 unifyTypesU _ _ _ = Nothing
 
 unifyTypeArgs :: (Monoid als, Eq als, ArrayDim dim) =>
@@ -85,6 +88,9 @@
   | sort (M.keys et1) == sort (M.keys et2) =
     ArrayRecordElem <$>
     traverse (uncurry $ unifyRecordArrayElemTypes uf) (M.intersectionWith (,) et1 et2)
+unifyArrayElemTypes _ (ArrayEnumElem cs1 als1) (ArrayEnumElem cs2 als2)
+  | cs1 == cs2 =
+     Just $ ArrayEnumElem cs1 (als1 <> als2)
 unifyArrayElemTypes _ _ _ =
   Nothing
 
@@ -170,6 +176,7 @@
         mayContainArray (Record fs) = any mayContainArray fs
         mayContainArray TypeVar{} = True
         mayContainArray Arrow{} = False
+        mayContainArray Enum{} = False
 checkTypeExp (TEArrow (Just v) t1 t2 loc) = do
   (t1', st1, _) <- checkTypeExp t1
   bindSpaced [(Term, v)] $ do
@@ -227,6 +234,12 @@
           throwError $ TypeError tloc $ "Type argument " ++ pretty a ++
           " not valid for a type parameter " ++ pretty p
 
+checkTypeExp t@(TEEnum names loc) = do
+  unless (sort names == sort (nub names)) $
+    throwError $ TypeError loc $ "Duplicate constructors in " ++ pretty t
+  unless (length names <= 256) $
+    throwError $ TypeError loc "Enums must have 256 or fewer constructors."
+  return (TEEnum names loc, Enum names,  Unlifted)
 
 checkNamedDim :: MonadTypeChecker m =>
                  SrcLoc -> QualName Name -> m (QualName VName)
@@ -249,6 +262,7 @@
         check (TuplePattern ps _) = mapM_ check ps
         check (RecordPattern fs _) = mapM_ (check . snd) fs
         check (PatternAscription p _ _) = check p
+        check PatternLit{} = return ()
 
         seen v loc = do
           already <- gets $ M.lookup v
@@ -276,6 +290,7 @@
         pats (TEApply t1 (TypeArgExpType t2) _) = pats t1 ++ pats t2
         pats (TEApply t1 TypeArgExpDim{} _) = pats t1
         pats TEVar{} = []
+        pats TEEnum{} = []
 
 checkTypeParams :: MonadTypeChecker m =>
                    [TypeParamBase Name]
@@ -323,6 +338,7 @@
     Record $ fmap (substituteTypes substs) ts
   Arrow als v t1 t2 ->
     Arrow als v (substituteTypes substs t1) (substituteTypes substs t2)
+  Enum cs -> Enum cs
   where nope = error "substituteTypes: Cannot create array after substitution."
 
         substituteTypesInArrayElem (ArrayPrimElem t ()) =
@@ -337,6 +353,8 @@
           Record ts'
           where ts' = fmap (substituteTypes substs .
                             fst . recordArrayElemToType) ts
+        substituteTypesInArrayElem (ArrayEnumElem cs ()) =
+          Enum cs
 
         substituteInTypeArg (TypeArgDim d loc) =
           TypeArgDim (substituteInDim d) loc
@@ -370,27 +388,37 @@
         mkSubst p a =
           error $ "applyType mkSubst: cannot substitute " ++ pretty a ++ " for " ++ pretty p
 
+-- | A type substituion may be a substitution or a yet-unknown
+-- substitution (but which is certainly an overloaded primitive
+-- type!).  The latter is used to remove aliases from types that are
+-- yet-unknown but that we know cannot carry aliases (see issue #682).
+data Subst t = Subst t | PrimSubst
+
+instance Functor Subst where
+  fmap f (Subst t) = Subst $ f t
+  fmap _ PrimSubst = PrimSubst
+
 -- | Class of types which allow for substitution of types with no
 -- annotations for type variable names.
 class Substitutable a where
-  applySubst :: (VName -> Maybe (TypeBase () ())) -> a -> a
+  applySubst :: (VName -> Maybe (Subst (TypeBase () ()))) -> a -> a
 
 instance Substitutable (TypeBase () ()) where
   applySubst = substTypesAny
 
 instance Substitutable (TypeBase () Names) where
-  applySubst = substTypesAny . (fmap fromStruct.)
+  applySubst = substTypesAny . (fmap (fmap fromStruct).)
 
 instance Substitutable (TypeBase (DimDecl VName) ()) where
-  applySubst = substTypesAny . (fmap vacuousShapeAnnotations.)
+  applySubst = substTypesAny . (fmap (fmap vacuousShapeAnnotations).)
 
 instance Substitutable (TypeBase (DimDecl VName) Names) where
-  applySubst = substTypesAny . (fmap (vacuousShapeAnnotations . fromStruct).)
+  applySubst = substTypesAny . (fmap (fmap (vacuousShapeAnnotations . fromStruct)).)
 
 -- | Perform substitutions, from type names to types, on a type. Works
 -- regardless of what shape and uniqueness information is attached to the type.
 substTypesAny :: (ArrayDim dim, Monoid as) =>
-                 (VName -> Maybe (TypeBase dim as))
+                 (VName -> Maybe (Subst (TypeBase dim as)))
               -> TypeBase dim as -> TypeBase dim as
 substTypesAny lookupSubst ot = case ot of
   Prim t -> Prim t
@@ -398,24 +426,30 @@
                       uncurry arrayOfWithAliases (subsArrayElem et) shape u
   -- We only substitute for a type variable with no arguments, since
   -- type parameters cannot have higher kind.
-  TypeVar _ u v []
-    | Just t <- lookupSubst $ qualLeaf (qualNameFromTypeName v) ->
-        t `setUniqueness` u
-  TypeVar als u v targs -> TypeVar als u v $ map subsTypeArg targs
+  TypeVar als u v targs ->
+    case lookupSubst $ qualLeaf (qualNameFromTypeName v) of
+      Just (Subst t) -> t `setUniqueness` u
+      Just PrimSubst -> TypeVar mempty u v $ map subsTypeArg targs
+      Nothing -> TypeVar als u v $ map subsTypeArg targs
   Record ts ->  Record $ fmap (substTypesAny lookupSubst) ts
   Arrow als v t1 t2 ->
     Arrow als v (substTypesAny lookupSubst t1) (substTypesAny lookupSubst t2)
+  Enum names -> Enum names
 
   where nope = error "substTypesAny: Cannot create array after substitution."
 
         subsArrayElem (ArrayPrimElem t as) = (Prim t, as)
-        subsArrayElem (ArrayPolyElem v [] as)
-          | Just t <-  lookupSubst $ qualLeaf (qualNameFromTypeName v) = (t, as)
         subsArrayElem (ArrayPolyElem v targs as) =
-          (TypeVar as Nonunique v (map subsTypeArg targs), as)
+          case lookupSubst $ qualLeaf $ qualNameFromTypeName v of
+            Just (Subst t) -> (t, as)
+            -- It is intentional that we do not handle PrimSubst
+            -- specially here, as we are inside an array, and that
+            -- gives the aliasing.
+            _ -> (TypeVar as Nonunique v (map subsTypeArg targs), as)
         subsArrayElem (ArrayRecordElem ts) =
           let ts' = fmap recordArrayElemToType ts
           in (Record $ fmap (substTypesAny lookupSubst . fst) ts', foldMap snd ts')
+        subsArrayElem (ArrayEnumElem cs as) = (Enum cs, as)
 
         subsTypeArg (TypeArgType t loc) =
           TypeArgType (substTypesAny lookupSubst t) loc
diff --git a/src/Language/Futhark/TypeChecker/Unify.hs b/src/Language/Futhark/TypeChecker/Unify.hs
--- a/src/Language/Futhark/TypeChecker/Unify.hs
+++ b/src/Language/Futhark/TypeChecker/Unify.hs
@@ -7,8 +7,10 @@
   , MonadUnify(..)
   , BreadCrumb(..)
   , typeError
+  , mkTypeVarName
 
   , zeroOrderType
+  , mustHaveConstr
   , mustHaveField
   , mustBeOneOf
   , equalityType
@@ -46,6 +48,7 @@
                 | Overloaded [PrimType] SrcLoc
                 | HasFields (M.Map Name (TypeBase () ())) SrcLoc
                 | Equality SrcLoc
+                | HasConstrs [Name] SrcLoc
                 deriving Show
 
 instance Located Constraint where
@@ -55,10 +58,13 @@
   locOf (Overloaded _ loc) = locOf loc
   locOf (HasFields _ loc) = locOf loc
   locOf (Equality loc) = locOf loc
+  locOf (HasConstrs _ loc) = locOf loc
 
-lookupSubst :: VName -> Constraints -> Maybe (TypeBase () ())
-lookupSubst v constraints = do Constraint t _ <- M.lookup v constraints
-                               Just t
+lookupSubst :: VName -> Constraints -> Maybe (Subst (TypeBase () ()))
+lookupSubst v constraints = case M.lookup v constraints of
+                              Just (Constraint t _) -> Just $ Subst t
+                              Just Overloaded{} -> Just PrimSubst
+                              _ -> Nothing
 
 class (MonadBreadCrumbs m, MonadError TypeError m) => MonadUnify m where
   getConstraints :: m Constraints
@@ -149,13 +155,14 @@
 
 applySubstInConstraint :: VName -> TypeBase () () -> Constraint -> Constraint
 applySubstInConstraint vn tp (Constraint t loc) =
-  Constraint (applySubst (`M.lookup` M.singleton vn tp) t) loc
+  Constraint (applySubst (flip M.lookup $ M.singleton vn $ Subst tp) t) loc
 applySubstInConstraint vn tp (HasFields fs loc) =
-  HasFields (M.map (applySubst (`M.lookup` M.singleton vn tp)) fs) loc
+  HasFields (M.map (applySubst (flip M.lookup $ M.singleton vn $ Subst tp)) fs) loc
 applySubstInConstraint _ _ (NoConstraint l loc) = NoConstraint l loc
 applySubstInConstraint _ _ (Overloaded ts loc) = Overloaded ts loc
 applySubstInConstraint _ _ (Equality loc) = Equality loc
 applySubstInConstraint _ _ (ParamType l loc) = ParamType l loc
+applySubstInConstraint _ _ (HasConstrs ns loc) = HasConstrs ns loc
 
 linkVarToType :: MonadUnify m => SrcLoc -> VName -> TypeBase () () -> m ()
 linkVarToType loc vn tp = do
@@ -177,7 +184,8 @@
                         | not $ isRigid v constraints -> linkVarToTypes loc v ts
                       _ ->
                         typeError loc $ "Cannot unify `" ++ prettyName vn ++ "' with type `" ++
-                        pretty tp ++ "' (must be one of " ++ intercalate ", " (map pretty ts) ++
+                        pretty tp ++ "' (`" ++ prettyName vn ++
+                        "` must be one of " ++ intercalate ", " (map pretty ts) ++
                         " due to use at " ++ locStr old_loc ++ ")."
               Just (HasFields required_fields old_loc) ->
                 case tp of
@@ -198,6 +206,21 @@
                        pretty tp ++ "' (must be a record with fields {" ++
                        required_fields' ++
                        "} due to use at " ++ locStr old_loc ++ ")."
+              Just (HasConstrs cs old_loc) ->
+                case tp of
+                  Enum t_cs
+                    | intersect cs t_cs == cs -> return ()
+                    | otherwise -> typeError loc $
+                       "Cannot unify `" ++ prettyName vn ++ "' with type `"
+                       ++ pretty tp ++ "'"
+                  TypeVar _ _ (TypeName [] v) []
+                    | not $ isRigid v constraints ->
+                        let addConstrs (HasConstrs cs' loc') (HasConstrs cs'' _) =
+                              HasConstrs (cs' `union` cs'') loc'
+                            addConstrs c _ = c
+                        in modifyConstraints $ M.insertWith addConstrs v $
+                           HasConstrs cs old_loc
+                  _ -> typeError loc "Cannot unify."
               _ -> return ()
   where tp' = removeUniqueness tp
 
@@ -260,6 +283,8 @@
               modifyConstraints $ M.insert vn (Equality loc)
             Just (Overloaded _ _) ->
               return () -- All primtypes support equality.
+            Just HasConstrs{} ->
+              return ()
             _ ->
               typeError loc $ "Type " ++ pretty (prettyName vn) ++
               " does not support equality."
@@ -287,6 +312,26 @@
               locStr ploc ++ " may be a function."
             _ -> return ()
 
+mustHaveConstr :: MonadUnify m =>
+                  SrcLoc -> Name -> TypeBase dim as -> m ()
+mustHaveConstr loc c t = do
+  constraints <- getConstraints
+  case t of
+    TypeVar _ _ (TypeName _ tn) []
+      | Just NoConstraint{} <- M.lookup tn constraints ->
+          modifyConstraints $ M.insert tn $ HasConstrs [c] loc
+      | Just (HasConstrs cs _) <- M.lookup tn constraints ->
+          if c `elem` cs
+          then return ()
+          else modifyConstraints $ M.insert tn $ HasConstrs (c:cs) loc
+    Enum cs
+      | c `elem` cs -> return ()
+      | otherwise   -> throwError $ TypeError loc $
+                       "Type " ++ pretty (toStructural t) ++
+                       " does not have a " ++ pretty c ++ " constructor."
+    _ -> do unify loc (toStructural t) $ Enum [c]
+            return ()
+
 mustHaveField :: (MonadUnify m, Monoid as) =>
                  SrcLoc -> Name -> TypeBase dim as -> m (TypeBase dim as)
 mustHaveField loc l t = do
@@ -300,7 +345,7 @@
           return l_type
       | Just (HasFields fields _) <- M.lookup tn constraints -> do
           case M.lookup l fields of
-            Just t' -> unify loc (toStructural t) t'
+            Just t' -> unify loc l_type' t'
             Nothing -> modifyConstraints $ M.insert tn $
                        HasFields (M.insert l l_type' fields) loc
           return l_type
@@ -332,9 +377,18 @@
     i <- do (x, i) <- get
             put (x, i+1)
             return i
-    let v = VName (nameFromString $ desc ++ show i) 0
+    let v = VName (mkTypeVarName desc i) 0
     modifyConstraints $ M.insert v $ NoConstraint Nothing loc
     return $ TypeVar mempty Nonunique (typeName v) []
+
+-- | Construct a the name of a new type variable given a base
+-- description and a tag number (note that this is distinct from
+-- actually constructing a VName; the tag here is intended for human
+-- consumption but the machine does not care).
+mkTypeVarName :: String -> Int -> Name
+mkTypeVarName desc i =
+  nameFromString $ desc ++ mapMaybe subscript (show i)
+  where subscript = flip lookup $ zip "0123456789" "₀₁₂₃₄₅₆₇₈₉"
 
 instance MonadBreadCrumbs UnifyM where
 
diff --git a/src/futhark-bench.hs b/src/futhark-bench.hs
--- a/src/futhark-bench.hs
+++ b/src/futhark-bench.hs
@@ -10,11 +10,11 @@
 import Control.Monad.Except
 import qualified Data.ByteString.Char8 as SBS
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Data.Map as M
 import Data.Either
 import Data.Maybe
 import Data.Semigroup ((<>))
 import Data.List
-import qualified Data.Map as M
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import qualified Data.Text.Encoding as T
@@ -27,6 +27,7 @@
 import System.Process.ByteString (readProcessWithExitCode)
 import System.Exit
 import qualified Data.Aeson as JSON
+import qualified Data.Aeson.Encoding.Internal as JSON
 import Text.Printf
 import Text.Regex.TDFA
 
@@ -57,24 +58,29 @@
 data DataResult = DataResult String (Either T.Text ([RunResult], T.Text))
 data BenchResult = BenchResult FilePath [DataResult]
 
-resultsToJSON :: [BenchResult] -> JSON.Value
-resultsToJSON = JSON.toJSON . M.fromList . map benchResultToJSObject
-  where benchResultToJSObject
-          :: BenchResult
-          -> (String, JSON.Value)
-        benchResultToJSObject (BenchResult prog rs) =
-          (prog, JSON.toJSON $ M.fromList
-                 [("datasets" :: String, M.fromList $ map dataResultToJSObject rs)])
-        dataResultToJSObject
-          :: DataResult
-          -> (String, JSON.Value)
-        dataResultToJSObject (DataResult desc (Left err)) =
-          (desc, JSON.toJSON $ show err)
-        dataResultToJSObject (DataResult desc (Right (runtimes, progerr))) =
-          (desc, JSON.toJSON $ M.fromList
-                 [("runtimes" :: String, JSON.toJSON $ map runMicroseconds runtimes),
-                  ("stderr", JSON.toJSON $ show progerr)])
+-- Intermediate types to help write the JSON instances.
+newtype DataResults = DataResults [DataResult]
 
+instance JSON.ToJSON DataResults where
+  toJSON (DataResults rs) =
+    JSON.object $ map dataResultJSON rs
+  toEncoding (DataResults rs) =
+    JSON.pairs $ mconcat $ map (uncurry (JSON..=) . dataResultJSON) rs
+
+dataResultJSON :: DataResult -> (T.Text, JSON.Value)
+dataResultJSON (DataResult desc (Left err)) =
+  (T.pack desc, JSON.toJSON $ show err)
+dataResultJSON (DataResult desc (Right (runtimes, progerr))) =
+  (T.pack desc, JSON.object
+                [("runtimes", JSON.toJSON $ map runMicroseconds runtimes),
+                 ("stderr", JSON.toJSON progerr)])
+
+encodeBenchResults :: [BenchResult] -> LBS.ByteString
+encodeBenchResults rs =
+  JSON.encodingToLazyByteString $ JSON.pairs $ mconcat $ do
+  BenchResult prog r <- rs
+  return $ T.pack prog JSON..= M.singleton ("datasets" :: T.Text) (DataResults r)
+
 fork :: (a -> IO b) -> a -> IO (MVar b)
 fork f x = do cell <- newEmptyMVar
               void $ forkIO $ do result <- f x
@@ -107,7 +113,7 @@
   results <- concat <$> mapM (runBenchmark opts) compiled_benchmarks
   case optJSON opts of
     Nothing -> return ()
-    Just file -> LBS.writeFile file $ JSON.encode $ resultsToJSON results
+    Just file -> LBS.writeFile file $ encodeBenchResults results
   when (anyFailed results) exitFailure
 
   where ignored f = any (`match` f) $ optIgnoreFiles opts
diff --git a/src/futhark-dataset.hs b/src/futhark-dataset.hs
--- a/src/futhark-dataset.hs
+++ b/src/futhark-dataset.hs
@@ -3,23 +3,21 @@
 -- specified type and shape.
 module Main (main) where
 
-import Control.Arrow (first)
 import Control.Monad
-import Control.Monad.State
+import Control.Monad.ST
 import qualified Data.Binary as Bin
-import qualified Data.ByteString.Lazy as BS
-import Data.Binary.IEEE754
-import Data.Binary.Put
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BS
 import qualified Data.Map.Strict as M
-import Data.List
 import qualified Data.Text as T
 import Data.Word
+import qualified Data.Vector.Unboxed.Mutable as UMVec
+import qualified Data.Vector.Unboxed as UVec
+import Data.Vector.Generic (freeze)
 
 import System.Console.GetOpt
 import System.Random
 
-import Language.Futhark.Syntax
+import Language.Futhark.Syntax hiding (Value, PrimValue(..), IntValue(..), FloatValue(..))
 import Language.Futhark.Attributes (UncheckedTypeExp, namesToPrimTypes)
 import Language.Futhark.Parser
 import Language.Futhark.Pretty ()
@@ -38,7 +36,7 @@
                   case format config of
                     Text -> mapM_ (putStrLn . pretty) vs
                     Binary -> mapM_ (BS.putStr . Bin.encode) vs
-                    Type -> mapM_ (putStrLn . valueType) vs
+                    Type -> mapM_ (putStrLn . pretty . valueType) vs
           | otherwise =
               Just $ zipWithM_ ($) (optOrders config) $ map mkStdGen [optSeed config..]
         f _ _ =
@@ -124,121 +122,37 @@
   where name = tname ++ "-bounds"
 
 tryMakeGenerator :: String -> Either String (RandomConfiguration -> OutputFormat -> StdGen  -> IO ())
-tryMakeGenerator t = do
-  t' <- toSimpleType =<< either (Left . show) Right (parseType name (T.pack t))
+tryMakeGenerator t
+  | Just vs <- readValues $ BS.pack t =
+      return $ \_ fmt _ -> mapM_ (putValue fmt) vs
+  | otherwise = do
+  t' <- toValueType =<< either (Left . show) Right (parseType name (T.pack t))
   return $ \conf fmt stdgen -> do
     let (v, _) = randomValue conf t' stdgen
-    case fmt of
-      Text -> printSimpleValueT v
-      Binary -> printSimpleValueB t' v
-      Type -> putStrLn t
+    putValue fmt v
   where name = "option " ++ t
-
-data SimpleType = SimpleArray SimpleType Int
-                | SimplePrim PrimType
-                  deriving (Show)
+        putValue Text = putStrLn . pretty
+        putValue Binary = BS.putStr . Bin.encode
+        putValue Type = putStrLn . pretty . valueType
 
-toSimpleType :: UncheckedTypeExp -> Either String SimpleType
-toSimpleType TETuple{} = Left "Cannot handle tuples yet."
-toSimpleType TERecord{} = Left "Cannot handle records yet."
-toSimpleType TEApply{} = Left "Cannot handle type applications yet."
-toSimpleType TEArrow{} = Left "Cannot generate functions."
-toSimpleType (TEUnique t _) = toSimpleType t
-toSimpleType (TEArray t d _) =
-  SimpleArray <$> toSimpleType t <*> constantDim d
+toValueType :: UncheckedTypeExp -> Either String ValueType
+toValueType TETuple{} = Left "Cannot handle tuples yet."
+toValueType TERecord{} = Left "Cannot handle records yet."
+toValueType TEApply{} = Left "Cannot handle type applications yet."
+toValueType TEArrow{} = Left "Cannot generate functions."
+toValueType TEEnum{} = Left "Cannot handle enums yet."
+toValueType (TEUnique t _) = toValueType t
+toValueType (TEArray t d _) = do
+  d' <- constantDim d
+  ValueType ds t' <- toValueType t
+  return $ ValueType (d':ds) t'
   where constantDim (ConstDim k) = Right k
         constantDim _ = Left "Array has non-constant dimension declaration."
-toSimpleType (TEVar (QualName [] v) _)
-  | Just t <- M.lookup v namesToPrimTypes = Right $ SimplePrim t
-toSimpleType (TEVar v _) =
+toValueType (TEVar (QualName [] v) _)
+  | Just t <- M.lookup v namesToPrimTypes = Right $ ValueType [] t
+toValueType (TEVar v _) =
   Left $ "Unknown type " ++ pretty v
 
-data SimpleValue = SimpleArrayValue [SimpleValue]
-                 | SimplePrimValue PrimValue
-                   deriving (Show)
-
--- Ordinary prettyprinting consumes too much memory, likely because it
--- manifests the string to print instead of doing it lazily, which is
--- a bad idea for giant values.  This is likely because it tries to do
--- a good job with respect to line wrapping and the like.  We opt to
--- do a bad job instead, but one that we can do much faster.
-printSimpleValueT :: SimpleValue -> IO ()
-printSimpleValueT = (>>putStrLn "") . flip evalStateT 0 . p
-  where elements_per_line = 20 :: Int
-
-        p (SimplePrimValue v) = do
-          maybeNewline
-          lift $ putStr $ pretty v
-        p (SimpleArrayValue []) =
-          lift $ putStr "[]"
-        p (SimpleArrayValue (v:vs)) = do
-          lift $ putStr "["
-          p v
-          forM_ vs $ \v' -> do
-            lift $ putStr ", "
-            p v'
-          lift $ putStr "]"
-
-        maybeNewline = do
-          i <- get
-          if i >= elements_per_line
-            then do lift $ putStrLn ""
-                    put 0
-            else put $ i + 1
-
-binaryFormatVersion :: Int
-binaryFormatVersion = 2
-
-printSimpleValueB :: SimpleType -> SimpleValue -> IO ()
-printSimpleValueB st sv =
-  BL.putStr $ runPut $ printHeader >> pSimpleValue sv
-
-  where
-    printHeader = do
-      Bin.put 'b'
-      putWord8 $ fromIntegral binaryFormatVersion
-      let dims = getDims st
-      putWord8 $ fromIntegral $ length dims
-      putElemType st
-      case sv of
-        SimplePrimValue _ -> return ()
-        SimpleArrayValue _ -> mapM_ (putWord64le . fromIntegral) dims
-
-    -- Simply calling @Bin.put (" i8" :: String)@ would cause a lot of bytes to
-    -- be written. Doing it this way will only write 4 bytes.
-    putElemType (SimplePrim (Signed Int8))  = mapM_ Bin.put ("  i8" :: String)
-    putElemType (SimplePrim (Signed Int16)) = mapM_ Bin.put (" i16" :: String)
-    putElemType (SimplePrim (Signed Int32)) = mapM_ Bin.put (" i32" :: String)
-    putElemType (SimplePrim (Signed Int64)) = mapM_ Bin.put (" i64" :: String)
-    putElemType (SimplePrim (Unsigned Int8))  = mapM_ Bin.put ("  u8" :: String)
-    putElemType (SimplePrim (Unsigned Int16)) = mapM_ Bin.put (" u16" :: String)
-    putElemType (SimplePrim (Unsigned Int32)) = mapM_ Bin.put (" u32" :: String)
-    putElemType (SimplePrim (Unsigned Int64)) = mapM_ Bin.put (" u64" :: String)
-    putElemType (SimplePrim (FloatType Float32)) = mapM_ Bin.put (" f32" :: String)
-    putElemType (SimplePrim (FloatType Float64)) = mapM_ Bin.put (" f64" :: String)
-    putElemType (SimplePrim Bool) = mapM_ Bin.put ("bool" :: String)
-    putElemType (SimpleArray ty _) = putElemType ty
-
-    getDims (SimplePrim _) = []
-    getDims (SimpleArray ty dim) = dim : getDims ty
-
-    pSimpleValue :: SimpleValue -> Put
-    pSimpleValue (SimplePrimValue pv) = p pv
-    pSimpleValue (SimpleArrayValue svs) = mapM_ pSimpleValue svs
-
-    p :: PrimValue -> Put
-    p (SignedValue (Int8Value v))    = putWord8    $ fromIntegral $ fromEnum v
-    p (SignedValue (Int16Value v))   = putWord16le $ fromIntegral $ fromEnum v
-    p (SignedValue (Int32Value v))   = putWord32le $ fromIntegral $ fromEnum v
-    p (SignedValue (Int64Value v))   = putWord64le $ fromIntegral $ fromEnum v
-    p (UnsignedValue (Int8Value v))  = putWord8    $ fromIntegral $ fromEnum v
-    p (UnsignedValue (Int16Value v)) = putWord16le $ fromIntegral $ fromEnum v
-    p (UnsignedValue (Int32Value v)) = putWord32le $ fromIntegral $ fromEnum v
-    p (UnsignedValue (Int64Value v)) = putWord64le $ fromIntegral $ fromEnum v
-    p (FloatValue (Float32Value v))  = putFloat32le v
-    p (FloatValue (Float64Value v))  = putFloat64le v
-    p (BoolValue v)                  = putWord8 $ if v then 1 else 0
-
 -- | Closed interval, as in @System.Random@.
 type Range a = (a, a)
 
@@ -286,63 +200,39 @@
   (minBound, maxBound) (minBound, maxBound) (minBound, maxBound) (minBound, maxBound)
   (0.0, 1.0) (0.0, 1.0)
 
-randomValue :: RandomConfiguration -> SimpleType -> StdGen -> (SimpleValue, StdGen)
-randomValue conf (SimplePrim (Signed Int8)) stdgen =
-  randomC conf i8Range stdgen
-randomValue conf (SimplePrim (Signed Int16)) stdgen =
-  randomC conf i16Range stdgen
-randomValue conf (SimplePrim (Signed Int32)) stdgen =
-  randomC conf i32Range stdgen
-randomValue conf (SimplePrim (Signed Int64)) stdgen =
-  randomC conf i64Range stdgen
-
-randomValue conf (SimplePrim (Unsigned Int8)) stdgen =
-  randomC conf u8Range stdgen
-randomValue conf (SimplePrim (Unsigned Int16)) stdgen =
-  randomC conf u16Range stdgen
-randomValue conf (SimplePrim (Unsigned Int32)) stdgen =
-  randomC conf u32Range stdgen
-randomValue conf (SimplePrim (Unsigned Int64)) stdgen =
-  randomC conf u64Range stdgen
-
-randomValue _ (SimplePrim Bool) stdgen =
-  first (SimplePrimValue . BoolValue) $ random stdgen
-
-randomValue conf (SimplePrim (FloatType Float32)) stdgen =
-  randomC conf f32Range stdgen
-randomValue conf (SimplePrim (FloatType Float64)) stdgen =
-  randomC conf f64Range stdgen
-
-randomValue conf (SimpleArray t d) stdgen =
-  first SimpleArrayValue $ uncurry (flip (,)) $
-  mapAccumL f stdgen [0..d-1]
-  where f stdgen' _ = uncurry (flip (,)) $ randomValue conf t stdgen'
-
-class ToFuthark a where
-  toFuthark :: a -> SimpleValue
-
-instance ToFuthark Int8 where
-  toFuthark = SimplePrimValue . SignedValue . Int8Value
-instance ToFuthark Int16 where
-  toFuthark = SimplePrimValue . SignedValue . Int16Value
-instance ToFuthark Int32 where
-  toFuthark = SimplePrimValue . SignedValue . Int32Value
-instance ToFuthark Int64 where
-  toFuthark = SimplePrimValue . SignedValue . Int64Value
-instance ToFuthark Word8 where
-  toFuthark = SimplePrimValue . UnsignedValue . Int8Value . fromIntegral
-instance ToFuthark Word16 where
-  toFuthark = SimplePrimValue . UnsignedValue . Int16Value . fromIntegral
-instance ToFuthark Word32 where
-  toFuthark = SimplePrimValue . UnsignedValue . Int32Value . fromIntegral
-instance ToFuthark Word64 where
-  toFuthark = SimplePrimValue . UnsignedValue . Int64Value . fromIntegral
-instance ToFuthark Float where
-  toFuthark = SimplePrimValue . FloatValue . Float32Value
-instance ToFuthark Double where
-  toFuthark = SimplePrimValue . FloatValue . Float64Value
+randomValue :: RandomConfiguration -> ValueType -> StdGen -> (Value, StdGen)
+randomValue conf (ValueType ds t) stdgen =
+  case t of
+    Signed Int8  -> gen  i8Range Int8Value
+    Signed Int16 -> gen i16Range Int16Value
+    Signed Int32 -> gen i32Range Int32Value
+    Signed Int64 -> gen i64Range Int64Value
+    Unsigned Int8  -> gen  u8Range Word8Value
+    Unsigned Int16 -> gen u16Range Word16Value
+    Unsigned Int32 -> gen u32Range Word32Value
+    Unsigned Int64 -> gen u64Range Word64Value
+    FloatType Float32 -> gen f32Range Float32Value
+    FloatType Float64 -> gen f64Range Float64Value
+    Bool -> gen (const (False,True)) BoolValue
+  where gen range final = randomVector (range conf) final ds stdgen
 
-randomC :: (ToFuthark a, Random a) =>
-           RandomConfiguration -> (RandomConfiguration -> Range a) -> StdGen
-        -> (SimpleValue, StdGen)
-randomC conf pick = first toFuthark . randomR (pick conf)
+randomVector :: (UMVec.Unbox v, Random v) =>
+                Range v
+             -> (UVec.Vector Int -> UVec.Vector v -> Value)
+             -> [Int] -> StdGen
+             -> (Value, StdGen)
+randomVector range final ds stdgen = runST $ do
+  -- USe some nice impure computation where we can preallocate a
+  -- vector of the desired size, populate it via the random number
+  -- generator, and then finally reutrn a frozen binary vector.
+  arr <- UMVec.new n
+  let fill stdgen' i
+        | i < n = do
+            let (v, stdgen'') = randomR range stdgen'
+            UMVec.write arr i v
+            fill stdgen'' $! i+1
+        | otherwise = do
+            arr' <- final (UVec.fromList ds) <$> freeze arr
+            return (arr', stdgen')
+  fill stdgen 0
+  where n = product ds
diff --git a/src/futhark.hs b/src/futhark.hs
--- a/src/futhark.hs
+++ b/src/futhark.hs
@@ -323,7 +323,10 @@
 -- | Entry point.  Non-interactive, except when reading interpreter
 -- input from standard input.
 main :: IO ()
-main = mainWithOptions newConfig commandLineOptions "options... program" compile
+main = do
+  hSetEncoding stdout utf8
+  hSetEncoding stderr utf8
+  mainWithOptions newConfig commandLineOptions "options... program" compile
   where compile [file] config =
           Just $ do
             res <- runFutharkM (m file config) $
diff --git a/src/futharki.hs b/src/futharki.hs
--- a/src/futharki.hs
+++ b/src/futharki.hs
@@ -199,10 +199,12 @@
       return (imports, src', tenv, ienv')
 
     Just file -> do
-      (_, imports, src) <-
+      (ws, imports, src) <-
         badOnLeft =<< liftIO (runExceptT (readProgram file)
                               `Haskeline.catch` \(err::IOException) ->
                                  return (Left (ExternalError (T.pack $ show err))))
+      liftIO $ hPrint stderr ws
+
       let imp = T.mkInitialImport "."
       ienv1 <- foldM (\ctx -> badOnLeft <=< runInterpreter' . I.interpretImport ctx) I.initialCtx $
                map (fmap fileProg) imports
@@ -232,7 +234,7 @@
   return $ "[" ++ show i ++ "]> "
 
 mkOpen :: FilePath -> UncheckedDec
-mkOpen f = OpenDec (ModImport f NoInfo noLoc) NoInfo noLoc
+mkOpen f = OpenDec (ModImport f NoInfo noLoc) noLoc
 
 -- The ExceptT part is more of a continuation, really.
 newtype FutharkiM a =
@@ -318,7 +320,7 @@
   (imports, src, tenv, ienv) <- getIt
   case showErr (T.checkExp imports src tenv e) of
     Left err -> liftIO $ putStrLn err
-    Right e' -> do
+    Right (_, e') -> do
       r <- runInterpreter $ I.interpretExp ienv e'
       case r of
         Left err -> liftIO $ print err
@@ -392,7 +394,9 @@
       (tenv, _) <- gets futharkiEnv
       case T.checkExp imports src tenv e' of
         Left err -> liftIO $ print err
-        Right e'' -> liftIO $ putStrLn $ pretty e' <> " : " <> pretty (typeOf e'')
+        Right (ps, e'') -> liftIO $ putStrLn $
+          pretty e' <> concatMap ((" "<>) . pretty) ps <>
+          " : " <> pretty (typeOf e'')
 
 unbreakCommand :: Command
 unbreakCommand _ = do