diff --git a/docs/man/futhark-autotune.rst b/docs/man/futhark-autotune.rst
--- a/docs/man/futhark-autotune.rst
+++ b/docs/man/futhark-autotune.rst
@@ -23,8 +23,6 @@
 automatically be picked up by subsequent uses of
 :ref:`futhark-bench(1)` and :ref:`futhark-test(1)`.
 
-Currently, only the entry point named ``main`` is tuned.
-
 
 OPTIONS
 =======
diff --git a/docs/man/futhark-c.rst b/docs/man/futhark-c.rst
--- a/docs/man/futhark-c.rst
+++ b/docs/man/futhark-c.rst
@@ -31,8 +31,8 @@
 -h
   Print help text to standard output and exit.
 
---entry NAME
-  Treat the specified top-level function as an entry point.
+--entry-point NAME
+  Treat this top-level function as an entry point.
 
 --library
   Generate a library instead of an executable.  Appends ``.c``/``.h``
diff --git a/docs/man/futhark-cuda.rst b/docs/man/futhark-cuda.rst
--- a/docs/man/futhark-cuda.rst
+++ b/docs/man/futhark-cuda.rst
@@ -35,8 +35,8 @@
 -h
   Print help text to standard output and exit.
 
---entry NAME
-  Treat the specified top-level function as an entry point.
+--entry-point NAME
+  Treat this top-level function as an entry point.
 
 --library
   Generate a library instead of an executable.  Appends ``.c``/``.h``
diff --git a/docs/man/futhark-literate.rst b/docs/man/futhark-literate.rst
--- a/docs/man/futhark-literate.rst
+++ b/docs/man/futhark-literate.rst
@@ -196,7 +196,9 @@
             : | "empty" "(" ("[" `decimal` "]" )+ `script_type` ")"
             : | "{" "}"
             : | "{" (`id` = `script_exp`) ("," `id` = `script_exp`)* "}"
+            : | "let" `script_pat` "=" `script_exp` "in" `script_exp`
             : | `literal`
+   script_pat:  `id` | "(" `id` ("," `id`) ")"
    script_fun:  `id` | "$" `id`
    script_type: `int_type` | `float_type` | "bool"
 
diff --git a/docs/man/futhark-multicore.rst b/docs/man/futhark-multicore.rst
--- a/docs/man/futhark-multicore.rst
+++ b/docs/man/futhark-multicore.rst
@@ -31,8 +31,8 @@
 -h
   Print help text to standard output and exit.
 
---entry NAME
-  Treat the specified top-level function as an entry point.
+--entry-point NAME
+  Treat this top-level function as an entry point.
 
 --library
   Generate a library instead of an executable.  Appends ``.c``/``.h``
diff --git a/docs/man/futhark-opencl.rst b/docs/man/futhark-opencl.rst
--- a/docs/man/futhark-opencl.rst
+++ b/docs/man/futhark-opencl.rst
@@ -31,8 +31,8 @@
 -h
   Print help text to standard output and exit.
 
---entry NAME
-  Treat the specified top-level function as an entry point.
+--entry-point NAME
+  Treat this top-level function as an entry point.
 
 --library
   Generate a library instead of an executable.  Appends ``.c``/``.h``
diff --git a/docs/man/futhark-pyopencl.rst b/docs/man/futhark-pyopencl.rst
--- a/docs/man/futhark-pyopencl.rst
+++ b/docs/man/futhark-pyopencl.rst
@@ -37,8 +37,8 @@
 -h
   Print help text to standard output and exit.
 
---entry NAME
-  Treat the specified top-level function as an entry point.
+--entry-point NAME
+  Treat this top-level function as an entry point.
 
 --library
   Instead of compiling to an executable program, generate a Python
diff --git a/docs/man/futhark-python.rst b/docs/man/futhark-python.rst
--- a/docs/man/futhark-python.rst
+++ b/docs/man/futhark-python.rst
@@ -31,8 +31,8 @@
 -h
   Print help text to standard output and exit.
 
---entry NAME
-  Treat the specified top-level function as an entry point.
+--entry-point NAME
+  Treat this top-level function as an entry point.
 
 --library
   Instead of compiling to an executable program, generate a Python
diff --git a/docs/man/futhark-test.rst b/docs/man/futhark-test.rst
--- a/docs/man/futhark-test.rst
+++ b/docs/man/futhark-test.rst
@@ -36,7 +36,7 @@
 
   [tags { tags... }]
   [entry: names...]
-  [compiled|nobench|random] input ({ values... } | @ filename)
+  [compiled|nobench|random|script] input ({ values... } | @ filename)
   output { values... } | auto output | error: regex
 
 If ``compiled`` is present before the ``input`` keyword, this test
@@ -53,10 +53,18 @@
 from sizes, integer constants (with or without type suffix), and
 floating-point constants (always with type suffix) are also permitted.
 
+If ``input`` is preceded by ``script``, the text between the curly
+braces is interpreted as a FutharkScript expression (see
+:ref:`futhark-literate(1)`), which is executed to generate the input.
+It must use only functions explicitly declared as entry points.  If
+the expression produces an *n*-element tuple, it will be unpacked and
+its components passed as *n* distinct arguments to the test function.
+
 If ``input`` is followed by an ``@`` and a file name (which must not
-contain any whitespace) instead of curly braces, values will be read
-from the indicated file.  This is recommended for large data sets.
-This notation cannot be used with ``random`` input.
+contain any whitespace) instead of curly braces, values or
+FutharkScript expression will be read from the indicated file.  This
+is recommended for large data sets.  This notation cannot be used with
+``random`` input.
 
 After the ``input`` block, the expected result of the test case is
 written as either ``output`` followed by another block of values, or
@@ -71,7 +79,8 @@
 with ``futhark-c`` and recording its result for the given input (which
 must not fail).  This is usually only useful for testing or
 benchmarking alternative compilers, and not for testing the
-correctness of Futhark programs.
+correctness of Futhark programs.  This currently does not work for
+``script`` inputs.
 
 Alternatively, instead of input-output pairs, the test cases can
 simply be a description of an expected compile time type error::
diff --git a/docs/man/futhark.rst b/docs/man/futhark.rst
--- a/docs/man/futhark.rst
+++ b/docs/man/futhark.rst
@@ -45,7 +45,7 @@
 
 Find the test dataset whose description contains ``DATASET``
 (e.g. ``#1``) and print it in binary representation to standard
-output.
+output.  This does not work for ``script`` datasets.
 
 futhark dev options... PROGRAM
 ------------------------------
diff --git a/docs/server-protocol.rst b/docs/server-protocol.rst
--- a/docs/server-protocol.rst
+++ b/docs/server-protocol.rst
@@ -82,6 +82,12 @@
 
 Delete the given variables.
 
+``rename`` *oldname* *newname*
+..............................
+
+Rename the variable *oldname* to *newname*, which must not already
+exist.
+
 ``inputs`` *entry*
 ..................
 
@@ -114,3 +120,11 @@
 ..........
 
 Corresponds to :c:func:`futhark_context_report`.
+
+Environment Variables
+---------------------
+
+``FUTHARK_COMPILER_DEBUGGING``
+..............................
+
+Turns on debugging output for the server when set to 1.
diff --git a/futhark.cabal b/futhark.cabal
--- a/futhark.cabal
+++ b/futhark.cabal
@@ -1,7 +1,7 @@
 cabal-version: 2.4
 -- Run 'cabal2nix . >futhark.nix' after adding deps.
 name:           futhark
-version:        0.19.5
+version:        0.19.6
 synopsis:       An optimising compiler for a functional, array-oriented language.
 
 description:    Futhark is a small programming language designed to be compiled to
@@ -140,6 +140,7 @@
       Futhark.CodeGen.SetDefaultSpace
       Futhark.Compiler
       Futhark.Compiler.CLI
+      Futhark.Compiler.Config
       Futhark.Compiler.Program
       Futhark.Construct
       Futhark.Doc.Generator
@@ -188,6 +189,7 @@
       Futhark.Internalise.Bindings
       Futhark.Internalise.Defunctionalise
       Futhark.Internalise.Defunctorise
+      Futhark.Internalise.Exps
       Futhark.Internalise.FreeVars
       Futhark.Internalise.Lambdas
       Futhark.Internalise.LiftLambdas
@@ -346,7 +348,7 @@
   main-is: src/futhark.hs
   other-modules:
       Paths_futhark
-  ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists -threaded -rtsopts "-with-rtsopts=-N -qg -H1G -A4M"
+  ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists -threaded -rtsopts "-with-rtsopts=-N -qg1 -A16M"
   build-depends:
       base
     , futhark
diff --git a/rts/c/cuda.h b/rts/c/cuda.h
--- a/rts/c/cuda.h
+++ b/rts/c/cuda.h
@@ -1,9 +1,28 @@
 // Start of cuda.h.
 
-#define CUDA_SUCCEED(x) cuda_api_succeed(x, #x, __FILE__, __LINE__)
+#define CUDA_SUCCEED_FATAL(x) cuda_api_succeed_fatal(x, #x, __FILE__, __LINE__)
+#define CUDA_SUCCEED_NONFATAL(x) cuda_api_succeed_nonfatal(x, #x, __FILE__, __LINE__)
 #define NVRTC_SUCCEED(x) nvrtc_api_succeed(x, #x, __FILE__, __LINE__)
 
-static inline void cuda_api_succeed(CUresult res, const char *call,
+#define CUDA_SUCCEED_OR_RETURN(e) {             \
+    char *serror = CUDA_SUCCEED_NONFATAL(e);    \
+    if (serror) {                                 \
+      if (!ctx->error) {                          \
+        ctx->error = serror;                      \
+        return bad;                               \
+      } else {                                    \
+        free(serror);                             \
+      }                                           \
+    }                                             \
+  }
+
+// CUDA_SUCCEED_OR_RETURN returns the value of the variable 'bad' in
+// scope.  By default, it will be this one.  Create a local variable
+// of some other type if needed.  This is a bit of a hack, but it
+// saves effort in the code generator.
+static const int bad = 1;
+
+static inline void cuda_api_succeed_fatal(CUresult res, const char *call,
     const char *file, int line) {
   if (res != CUDA_SUCCESS) {
     const char *err_str;
@@ -14,6 +33,19 @@
   }
 }
 
+static char* cuda_api_succeed_nonfatal(CUresult res, const char *call,
+    const char *file, int line) {
+  if (res != CUDA_SUCCESS) {
+    const char *err_str;
+    cuGetErrorString(res, &err_str);
+    if (err_str == NULL) { err_str = "Unknown"; }
+    return msgprintf("%s:%d: CUDA call\n  %s\nfailed with error code %d (%s)\n",
+        file, line, call, res, err_str);
+  } else {
+    return NULL;
+  }
+}
+
 static inline void nvrtc_api_succeed(nvrtcResult res, const char *call,
                                      const char *file, int line) {
   if (res != NVRTC_SUCCESS) {
@@ -119,7 +151,7 @@
 #define device_query(dev,attrib) _device_query(dev, CU_DEV_ATTR(attrib))
 static int _device_query(CUdevice dev, CUdevice_attribute attrib) {
   int val;
-  CUDA_SUCCEED(cuDeviceGetAttribute(&val, attrib, dev));
+  CUDA_SUCCEED_FATAL(cuDeviceGetAttribute(&val, attrib, dev));
   return val;
 }
 
@@ -127,7 +159,7 @@
 #define function_query(fn,attrib) _function_query(dev, CU_FUN_ATTR(attrib))
 static int _function_query(CUfunction dev, CUfunction_attribute attrib) {
   int val;
-  CUDA_SUCCEED(cuFuncGetAttribute(&val, attrib, dev));
+  CUDA_SUCCEED_FATAL(cuFuncGetAttribute(&val, attrib, dev));
   return val;
 }
 
@@ -154,7 +186,7 @@
   int cc_major, cc_minor;
   CUdevice dev;
 
-  CUDA_SUCCEED(cuDeviceGetCount(&count));
+  CUDA_SUCCEED_FATAL(cuDeviceGetCount(&count));
   if (count == 0) { return 1; }
 
   int num_device_matches = 0;
@@ -164,12 +196,12 @@
   // This should maybe be changed, since greater compute capability is not
   // necessarily an indicator of better performance.
   for (int i = 0; i < count; i++) {
-    CUDA_SUCCEED(cuDeviceGet(&dev, i));
+    CUDA_SUCCEED_FATAL(cuDeviceGet(&dev, i));
 
     cc_major = device_query(dev, COMPUTE_CAPABILITY_MAJOR);
     cc_minor = device_query(dev, COMPUTE_CAPABILITY_MINOR);
 
-    CUDA_SUCCEED(cuDeviceGetName(name, sizeof(name) - 1, dev));
+    CUDA_SUCCEED_FATAL(cuDeviceGetName(name, sizeof(name) - 1, dev));
     name[sizeof(name) - 1] = 0;
 
     if (ctx->cfg.debugging) {
@@ -205,7 +237,7 @@
     fprintf(stderr, "Using device #%d\n", chosen);
   }
 
-  CUDA_SUCCEED(cuDeviceGet(&ctx->dev, chosen));
+  CUDA_SUCCEED_FATAL(cuDeviceGet(&ctx->dev, chosen));
   return 0;
 }
 
@@ -463,7 +495,7 @@
     dump_file(ctx->cfg.dump_ptx_to, ptx, strlen(ptx));
   }
 
-  CUDA_SUCCEED(cuModuleLoadData(&ctx->module, ptx));
+  CUDA_SUCCEED_FATAL(cuModuleLoadData(&ctx->module, ptx));
 
   free(ptx);
   if (src != NULL) {
@@ -472,12 +504,12 @@
 }
 
 static void cuda_setup(struct cuda_context *ctx, const char *src_fragments[], const char *extra_opts[]) {
-  CUDA_SUCCEED(cuInit(0));
+  CUDA_SUCCEED_FATAL(cuInit(0));
 
   if (cuda_device_setup(ctx) != 0) {
     futhark_panic(-1, "No suitable CUDA device found.\n");
   }
-  CUDA_SUCCEED(cuCtxCreate(&ctx->cu_ctx, 0, ctx->dev));
+  CUDA_SUCCEED_FATAL(cuCtxCreate(&ctx->cu_ctx, 0, ctx->dev));
 
   free_list_init(&ctx->free_list);
 
@@ -546,11 +578,11 @@
 static CUresult cuda_free_all(struct cuda_context *ctx);
 
 static void cuda_cleanup(struct cuda_context *ctx) {
-  CUDA_SUCCEED(cuda_free_all(ctx));
+  CUDA_SUCCEED_FATAL(cuda_free_all(ctx));
   (void)cuda_tally_profiling_records(ctx);
   free(ctx->profiling_records);
-  CUDA_SUCCEED(cuModuleUnload(ctx->module));
-  CUDA_SUCCEED(cuCtxDestroy(ctx->cu_ctx));
+  CUDA_SUCCEED_FATAL(cuModuleUnload(ctx->module));
+  CUDA_SUCCEED_FATAL(cuCtxDestroy(ctx->cu_ctx));
 }
 
 static CUresult cuda_alloc(struct cuda_context *ctx, size_t min_size,
diff --git a/rts/c/server.h b/rts/c/server.h
--- a/rts/c/server.h
+++ b/rts/c/server.h
@@ -425,6 +425,28 @@
   }
 }
 
+void cmd_rename(struct server_state *s, const char *args[]) {
+  const char *oldname = get_arg(args, 0);
+  const char *newname = get_arg(args, 1);
+  struct variable *old = get_variable(s, oldname);
+  struct variable *new = get_variable(s, newname);
+
+  if (old == NULL) {
+    failure();
+    printf("Unknown variable: %s\n", oldname);
+    return;
+  }
+
+  if (new != NULL) {
+    failure();
+    printf("Variable already exists: %s\n", newname);
+    return;
+  }
+
+  free(old->name);
+  old->name = strdup(newname);
+}
+
 void cmd_inputs(struct server_state *s, const char *args[]) {
   const char *name = get_arg(args, 0);
   struct entry_point *e = get_entry_point(s, name);
@@ -558,6 +580,8 @@
     cmd_store(s, tokens+1);
   } else if (strcmp(command, "free") == 0) {
     cmd_free(s, tokens+1);
+  } else if (strcmp(command, "rename") == 0) {
+    cmd_rename(s, tokens+1);
   } else if (strcmp(command, "inputs") == 0) {
     cmd_inputs(s, tokens+1);
   } else if (strcmp(command, "outputs") == 0) {
diff --git a/rts/python/server.py b/rts/python/server.py
--- a/rts/python/server.py
+++ b/rts/python/server.py
@@ -29,6 +29,10 @@
         if not vname in self._vars:
             raise self.Failure('Unknown variable: %s' % vname)
 
+    def _check_new_var(self, vname):
+        if vname in self._vars:
+            raise self.Failure('Variable already exists: %s' % vname)
+
     def _get_var(self, vname):
         self._check_var(vname)
         return self._vars[vname]
@@ -51,6 +55,14 @@
             self._check_var(vname)
             del self._vars[vname]
 
+    def _cmd_rename(self, args):
+        oldname = self._get_arg(args, 0)
+        newname = self._get_arg(args, 1)
+        self._check_var(oldname)
+        self._check_new_var(newname)
+        self._vars[newname] = self._vars[oldname]
+        del self._vars[oldname]
+
     def _cmd_call(self, args):
         entry = self._get_entry_point(self._get_arg(args, 0))
         num_ins = len(entry[0])
@@ -63,8 +75,7 @@
         out_vnames = args[1:num_outs+1]
 
         for out_vname in out_vnames:
-            if out_vname in self._vars:
-                raise self.Failure('Variable already exists: %s' % out_vname)
+            self._check_new_var(out_vname)
 
         in_vnames = args[1+num_outs:]
         ins = [ self._get_var(in_vname) for in_vname in in_vnames ]
@@ -146,6 +157,7 @@
                   'restore': _cmd_restore,
                   'store': _cmd_store,
                   'free': _cmd_free,
+                  'rename': _cmd_rename,
                   'clear': _cmd_dummy,
                   'pause_profiling': _cmd_dummy,
                   'unpause_profiling': _cmd_dummy,
diff --git a/src/Futhark/Actions.hs b/src/Futhark/Actions.hs
--- a/src/Futhark/Actions.hs
+++ b/src/Futhark/Actions.hs
@@ -13,6 +13,8 @@
     compileOpenCLAction,
     compileCUDAAction,
     compileMulticoreAction,
+    compilePythonAction,
+    compilePyOpenCLAction,
   )
 where
 
@@ -24,7 +26,9 @@
 import qualified Futhark.CodeGen.Backends.CCUDA as CCUDA
 import qualified Futhark.CodeGen.Backends.COpenCL as COpenCL
 import qualified Futhark.CodeGen.Backends.MulticoreC as MulticoreC
+import qualified Futhark.CodeGen.Backends.PyOpenCL as PyOpenCL
 import qualified Futhark.CodeGen.Backends.SequentialC as SequentialC
+import qualified Futhark.CodeGen.Backends.SequentialPython as SequentialPy
 import qualified Futhark.CodeGen.ImpGen.Kernels as ImpGenKernels
 import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGenMulticore
 import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGenSequential
@@ -35,6 +39,8 @@
 import Futhark.IR.Prop.Aliases
 import Futhark.IR.SeqMem (SeqMem)
 import Futhark.Util (runProgramWithExitCode, unixEnvironment)
+import Futhark.Version (versionString)
+import System.Directory
 import System.Exit
 import System.FilePath
 import qualified System.Info
@@ -93,6 +99,22 @@
       actionProcedure = liftIO . putStrLn . pretty . snd <=< ImpGenMulticore.compileProg
     }
 
+-- Lines that we prepend (in comments) to generated code.
+headerLines :: [String]
+headerLines = lines $ "Generated by Futhark " ++ versionString
+
+cHeaderLines :: [String]
+cHeaderLines = map ("// " <>) headerLines
+
+pyHeaderLines :: [String]
+pyHeaderLines = map ("# " <>) headerLines
+
+cPrependHeader :: String -> String
+cPrependHeader = (unlines cHeaderLines ++)
+
+pyPrependHeader :: String -> String
+pyPrependHeader = (unlines pyHeaderLines ++)
+
 cmdCC :: String
 cmdCC = fromMaybe "cc" $ lookup "CC" unixEnvironment
 
@@ -141,8 +163,8 @@
       case mode of
         ToLibrary -> do
           let (header, impl) = SequentialC.asLibrary cprog
-          liftIO $ writeFile hpath header
-          liftIO $ writeFile cpath impl
+          liftIO $ writeFile hpath $ cPrependHeader header
+          liftIO $ writeFile cpath $ cPrependHeader impl
         ToExecutable -> do
           liftIO $ writeFile cpath $ SequentialC.asExecutable cprog
           runCC cpath outpath ["-O3", "-std=c99"] ["-lm"]
@@ -174,13 +196,13 @@
       case mode of
         ToLibrary -> do
           let (header, impl) = COpenCL.asLibrary cprog
-          liftIO $ writeFile hpath header
-          liftIO $ writeFile cpath impl
+          liftIO $ writeFile hpath $ cPrependHeader header
+          liftIO $ writeFile cpath $ cPrependHeader impl
         ToExecutable -> do
-          liftIO $ writeFile cpath $ COpenCL.asExecutable cprog
+          liftIO $ writeFile cpath $ cPrependHeader $ COpenCL.asExecutable cprog
           runCC cpath outpath ["-O", "-std=c99"] ("-lm" : extra_options)
         ToServer -> do
-          liftIO $ writeFile cpath $ COpenCL.asServer cprog
+          liftIO $ writeFile cpath $ cPrependHeader $ COpenCL.asServer cprog
           runCC cpath outpath ["-O", "-std=c99"] ("-lm" : extra_options)
 
 -- | The @futhark cuda@ action.
@@ -204,13 +226,13 @@
       case mode of
         ToLibrary -> do
           let (header, impl) = CCUDA.asLibrary cprog
-          liftIO $ writeFile hpath header
-          liftIO $ writeFile cpath impl
+          liftIO $ writeFile hpath $ cPrependHeader header
+          liftIO $ writeFile cpath $ cPrependHeader impl
         ToExecutable -> do
-          liftIO $ writeFile cpath $ CCUDA.asExecutable cprog
+          liftIO $ writeFile cpath $ cPrependHeader $ CCUDA.asExecutable cprog
           runCC cpath outpath ["-O", "-std=c99"] ("-lm" : extra_options)
         ToServer -> do
-          liftIO $ writeFile cpath $ CCUDA.asServer cprog
+          liftIO $ writeFile cpath $ cPrependHeader $ CCUDA.asServer cprog
           runCC cpath outpath ["-O", "-std=c99"] ("-lm" : extra_options)
 
 -- | The @futhark multicore@ action.
@@ -230,11 +252,49 @@
       case mode of
         ToLibrary -> do
           let (header, impl) = MulticoreC.asLibrary cprog
-          liftIO $ writeFile hpath header
-          liftIO $ writeFile cpath impl
+          liftIO $ writeFile hpath $ cPrependHeader header
+          liftIO $ writeFile cpath $ cPrependHeader impl
         ToExecutable -> do
-          liftIO $ writeFile cpath $ MulticoreC.asExecutable cprog
+          liftIO $ writeFile cpath $ cPrependHeader $ MulticoreC.asExecutable cprog
           runCC cpath outpath ["-O", "-std=c99"] ["-lm", "-pthread"]
         ToServer -> do
-          liftIO $ writeFile cpath $ MulticoreC.asServer cprog
+          liftIO $ writeFile cpath $ cPrependHeader $ MulticoreC.asServer cprog
           runCC cpath outpath ["-O", "-std=c99"] ["-lm", "-pthread"]
+
+pythonCommon ::
+  (CompilerMode -> String -> prog -> FutharkM (Warnings, String)) ->
+  FutharkConfig ->
+  CompilerMode ->
+  FilePath ->
+  prog ->
+  FutharkM ()
+pythonCommon codegen fcfg mode outpath prog = do
+  let class_name =
+        case mode of
+          ToLibrary -> takeBaseName outpath
+          _ -> "internal"
+  pyprog <- handleWarnings fcfg $ codegen mode class_name prog
+
+  case mode of
+    ToLibrary ->
+      liftIO $ writeFile (outpath `addExtension` "py") $ pyPrependHeader pyprog
+    _ -> liftIO $ do
+      writeFile outpath $ "#!/usr/bin/env python3\n" ++ pyPrependHeader pyprog
+      perms <- liftIO $ getPermissions outpath
+      setPermissions outpath $ setOwnerExecutable True perms
+
+compilePythonAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
+compilePythonAction fcfg mode outpath =
+  Action
+    { actionName = "Compile to PyOpenCL",
+      actionDescription = "Compile to Python with OpenCL",
+      actionProcedure = pythonCommon SequentialPy.compileProg fcfg mode outpath
+    }
+
+compilePyOpenCLAction :: FutharkConfig -> CompilerMode -> FilePath -> Action KernelsMem
+compilePyOpenCLAction fcfg mode outpath =
+  Action
+    { actionName = "Compile to PyOpenCL",
+      actionDescription = "Compile to Python with OpenCL",
+      actionProcedure = pythonCommon PyOpenCL.compileProg fcfg mode outpath
+    }
diff --git a/src/Futhark/Bench.hs b/src/Futhark/Bench.hs
--- a/src/Futhark/Bench.hs
+++ b/src/Futhark/Bench.hs
@@ -139,12 +139,6 @@
     runResultAction :: Maybe (Int -> IO ())
   }
 
-cmdMaybe :: (MonadError T.Text m, MonadIO m) => IO (Maybe CmdFailure) -> m ()
-cmdMaybe = maybe (pure ()) (throwError . T.unlines . failureMsg) <=< liftIO
-
-cmdEither :: (MonadError T.Text m, MonadIO m) => IO (Either CmdFailure a) -> m a
-cmdEither = either (throwError . T.unlines . failureMsg) pure <=< liftIO
-
 -- | Run the benchmark program on the indicated dataset.
 benchmarkDataset ::
   Server ->
@@ -161,17 +155,13 @@
   input_types <- cmdEither $ cmdInputs server entry
   let outs = ["out" <> T.pack (show i) | i <- [0 .. length output_types -1]]
       ins = ["in" <> T.pack (show i) | i <- [0 .. length input_types -1]]
-      freeOuts = cmdMaybe (cmdFree server outs)
-      freeIns = cmdMaybe (cmdFree server ins)
 
   cmdMaybe . liftIO $ cmdClear server
 
-  either throwError pure
-    <=< withValuesFile futhark dir input_spec
-    $ \values_f ->
-      runExceptT $ do
-        checkValueTypes values_f input_types
-        cmdMaybe $ cmdRestore server values_f (zip ins input_types)
+  valuesAsVars server (zip ins input_types) futhark dir input_spec
+
+  let freeOuts = cmdMaybe (cmdFree server outs)
+      freeIns = cmdMaybe (cmdFree server ins)
 
   let runtime l
         | Just l' <- T.stripPrefix "runtime: " l,
diff --git a/src/Futhark/CLI/Literate.hs b/src/Futhark/CLI/Literate.hs
--- a/src/Futhark/CLI/Literate.hs
+++ b/src/Futhark/CLI/Literate.hs
@@ -851,7 +851,7 @@
       script <- parseProgFile prog
 
       unless (scriptSkipCompilation opts) $ do
-        let entryOpt v = "--entry=" ++ T.unpack v
+        let entryOpt v = "--entry-point=" ++ T.unpack v
             compile_options =
               "--server" :
               map entryOpt (S.toList (varsInScripts script))
diff --git a/src/Futhark/CLI/PyOpenCL.hs b/src/Futhark/CLI/PyOpenCL.hs
--- a/src/Futhark/CLI/PyOpenCL.hs
+++ b/src/Futhark/CLI/PyOpenCL.hs
@@ -3,12 +3,9 @@
 -- | @futhark pyopencl@
 module Futhark.CLI.PyOpenCL (main) where
 
-import Control.Monad.IO.Class
-import qualified Futhark.CodeGen.Backends.PyOpenCL as PyOpenCL
+import Futhark.Actions (compilePyOpenCLAction)
 import Futhark.Compiler.CLI
 import Futhark.Passes
-import System.Directory
-import System.FilePath
 
 -- | Run @futhark pyopencl@.
 main :: String -> [String] -> IO ()
@@ -18,17 +15,5 @@
   "Compile PyOpenCL"
   "Generate Python + OpenCL code from optimised Futhark program."
   gpuPipeline
-  $ \fcfg () mode outpath prog -> do
-    let class_name =
-          case mode of
-            ToLibrary -> takeBaseName outpath
-            _ -> "internal"
-    pyprog <- handleWarnings fcfg $ PyOpenCL.compileProg mode class_name prog
-
-    case mode of
-      ToLibrary ->
-        liftIO $ writeFile (outpath `addExtension` "py") pyprog
-      _ -> liftIO $ do
-        writeFile outpath pyprog
-        perms <- liftIO $ getPermissions outpath
-        setPermissions outpath $ setOwnerExecutable True perms
+  $ \fcfg () mode outpath prog ->
+    actionProcedure (compilePyOpenCLAction fcfg mode outpath) prog
diff --git a/src/Futhark/CLI/Python.hs b/src/Futhark/CLI/Python.hs
--- a/src/Futhark/CLI/Python.hs
+++ b/src/Futhark/CLI/Python.hs
@@ -3,12 +3,9 @@
 -- | @futhark py@
 module Futhark.CLI.Python (main) where
 
-import Control.Monad.IO.Class
-import qualified Futhark.CodeGen.Backends.SequentialPython as SequentialPy
+import Futhark.Actions (compilePythonAction)
 import Futhark.Compiler.CLI
 import Futhark.Passes
-import System.Directory
-import System.FilePath
 
 -- | Run @futhark py@
 main :: String -> [String] -> IO ()
@@ -18,17 +15,5 @@
   "Compile sequential Python"
   "Generate sequential Python code from optimised Futhark program."
   sequentialCpuPipeline
-  $ \fcfg () mode outpath prog -> do
-    let class_name =
-          case mode of
-            ToLibrary -> takeBaseName outpath
-            _ -> "internal"
-    pyprog <- handleWarnings fcfg $ SequentialPy.compileProg mode class_name prog
-
-    case mode of
-      ToLibrary ->
-        liftIO $ writeFile (outpath `addExtension` "py") pyprog
-      _ -> liftIO $ do
-        writeFile outpath pyprog
-        perms <- liftIO $ getPermissions outpath
-        setPermissions outpath $ setOwnerExecutable True perms
+  $ \fcfg () mode outpath prog ->
+    actionProcedure (compilePythonAction fcfg mode outpath) prog
diff --git a/src/Futhark/CLI/REPL.hs b/src/Futhark/CLI/REPL.hs
--- a/src/Futhark/CLI/REPL.hs
+++ b/src/Futhark/CLI/REPL.hs
@@ -22,7 +22,7 @@
 import Futhark.Compiler
 import Futhark.MonadFreshNames
 import Futhark.Pipeline
-import Futhark.Util (toPOSIX)
+import Futhark.Util (fancyTerminal, toPOSIX)
 import Futhark.Util.Options
 import Futhark.Version
 import Language.Futhark
@@ -57,12 +57,13 @@
 
 repl :: Maybe FilePath -> IO ()
 repl maybe_prog = do
-  putStr banner
-  putStrLn $ "Version " ++ showVersion version ++ "."
-  putStrLn "Copyright (C) DIKU, University of Copenhagen, released under the ISC license."
-  putStrLn ""
-  putStrLn "Run :help for a list of commands."
-  putStrLn ""
+  when fancyTerminal $ do
+    putStr banner
+    putStrLn $ "Version " ++ showVersion version ++ "."
+    putStrLn "Copyright (C) DIKU, University of Copenhagen, released under the ISC license."
+    putStrLn ""
+    putStrLn "Run :help for a list of commands."
+    putStrLn ""
 
   let toploop s = do
         (stop, s') <- runStateT (runExceptT $ runFutharkiM $ forever readEvalPrint) s
@@ -82,7 +83,7 @@
           Right _ -> return ()
 
       finish s = do
-        quit <- confirmQuit
+        quit <- if fancyTerminal then confirmQuit else pure True
         if quit then return () else toploop s
 
   maybe_init_state <- liftIO $ newFutharkiState 0 maybe_prog
@@ -167,14 +168,9 @@
 
       -- Then make the prelude available in the type checker.
       (tenv, d, src') <-
-        badOnLeft pretty $
-          snd $
-            T.checkDec
-              imports
-              src
-              T.initialEnv
-              (T.mkInitialImport ".")
-              $ mkOpen "/prelude/prelude"
+        badOnLeft pretty . snd $
+          T.checkDec imports src T.initialEnv (T.mkInitialImport ".") $
+            mkOpen "/prelude/prelude"
       -- Then in the interpreter.
       ienv' <- badOnLeft show =<< runInterpreter' (I.interpretDec ienv d)
       return (imports, src', tenv, ienv')
@@ -193,15 +189,11 @@
         foldM (\ctx -> badOnLeft show <=< runInterpreter' . I.interpretImport ctx) I.initialCtx $
           map (fmap fileProg) imports
       (tenv1, d1, src') <-
-        badOnLeft pretty $
-          snd $
-            T.checkDec imports src T.initialEnv imp $
-              mkOpen "/prelude/prelude"
+        badOnLeft pretty . snd . T.checkDec imports src T.initialEnv imp $
+          mkOpen "/prelude/prelude"
       (tenv2, d2, src'') <-
-        badOnLeft pretty $
-          snd $
-            T.checkDec imports src' tenv1 imp $
-              mkOpen $ toPOSIX $ dropExtension file
+        badOnLeft pretty . snd . T.checkDec imports src' tenv1 imp $
+          mkOpen $ toPOSIX $ dropExtension file
       ienv2 <- badOnLeft show =<< runInterpreter' (I.interpretDec ienv1 d1)
       ienv3 <- badOnLeft show =<< runInterpreter' (I.interpretDec ienv2 d2)
       return (imports, src'', tenv2, ienv3)
@@ -257,10 +249,9 @@
         [] -> liftIO $ T.putStrLn $ "Unknown command '" <> cmdname <> "'"
         [(_, (cmdf, _))] -> cmdf arg
         matches ->
-          liftIO $
-            T.putStrLn $
-              "Ambiguous command; could be one of "
-                <> mconcat (intersperse ", " (map fst matches))
+          liftIO . T.putStrLn $
+            "Ambiguous command; could be one of "
+              <> mconcat (intersperse ", " (map fst matches))
     _ -> do
       -- Read a declaration or expression.
       maybe_dec_or_e <- parseDecOrExpIncrM (inputLine "  ") prompt line
@@ -377,16 +368,14 @@
         -- Note the cleverness to preserve the Haskeline session (for
         -- line history and such).
         (stop, s') <-
-          FutharkiM $
-            lift $
-              lift $
-                runStateT
-                  (runExceptT $ runFutharkiM $ forever readEvalPrint)
-                  s
-                    { futharkiEnv = (tenv, ctx),
-                      futharkiCount = futharkiCount s + 1,
-                      futharkiBreaking = Just breaking
-                    }
+          FutharkiM . lift . lift $
+            runStateT
+              (runExceptT $ runFutharkiM $ forever readEvalPrint)
+              s
+                { futharkiEnv = (tenv, ctx),
+                  futharkiCount = futharkiCount s + 1,
+                  futharkiBreaking = Just breaking
+                }
 
         case stop of
           Left (Load file) -> throwError $ Load file
diff --git a/src/Futhark/CLI/Test.hs b/src/Futhark/CLI/Test.hs
--- a/src/Futhark/CLI/Test.hs
+++ b/src/Futhark/CLI/Test.hs
@@ -183,26 +183,21 @@
 runInterpretedEntry (FutharkExe futhark) program (InputOutputs entry run_cases) =
   let dir = takeDirectory program
       runInterpretedCase run@(TestRun _ inputValues _ index _) =
-        unless ("compiled" `elem` runTags run) $
-          context
-            ( "Entry point: " <> entry
-                <> "; dataset: "
-                <> T.pack (runDescription run)
-            )
-            $ do
-              input <- T.unlines . map prettyText <$> getValues (FutharkExe futhark) dir inputValues
-              expectedResult' <- getExpectedResult (FutharkExe futhark) program entry run
-              (code, output, err) <-
-                liftIO $
-                  readProcessWithExitCode futhark ["run", "-e", T.unpack entry, program] $
-                    T.encodeUtf8 input
-              case code of
-                ExitFailure 127 ->
-                  throwError $ progNotFound $ T.pack futhark
-                _ ->
-                  liftExcept $
-                    compareResult entry index program expectedResult'
-                      =<< runResult program code output err
+        unless (any (`elem` runTags run) ["compiled", "script"]) $
+          context ("Entry point: " <> entry <> "; dataset: " <> T.pack (runDescription run)) $ do
+            input <- T.unlines . map prettyText <$> getValues (FutharkExe futhark) dir inputValues
+            expectedResult' <- getExpectedResult (FutharkExe futhark) program entry run
+            (code, output, err) <-
+              liftIO $
+                readProcessWithExitCode futhark ["run", "-e", T.unpack entry, program] $
+                  T.encodeUtf8 input
+            case code of
+              ExitFailure 127 ->
+                throwError $ progNotFound $ T.pack futhark
+              _ ->
+                liftExcept $
+                  compareResult entry index program expectedResult'
+                    =<< runResult program code output err
    in accErrors_ $ map runInterpretedCase run_cases
 
 runTestCase :: TestCase -> TestM ()
@@ -286,7 +281,7 @@
     dir = takeDirectory program
 
     runCompiledCase input_types outs ins run = runExceptT $ do
-      let TestRun _ inputValues _ index _ = run
+      let TestRun _ input_spec _ index _ = run
           case_ctx =
             "Entry point: " <> entry <> "; dataset: "
               <> T.pack (runDescription run)
@@ -294,11 +289,7 @@
       context1 case_ctx $ do
         expected <- getExpectedResult futhark program entry run
 
-        either E.throwError pure
-          <=< withValuesFile futhark dir inputValues
-          $ \values_f -> runExceptT $ do
-            checkValueTypes values_f input_types
-            liftCommand $ cmdRestore server values_f (zip ins input_types)
+        valuesAsVars server (zip ins input_types) futhark dir input_spec
 
         call_r <- liftIO $ cmdCall server entry outs ins
         liftCommand $ cmdFree server ins
diff --git a/src/Futhark/CodeGen/Backends/CCUDA.hs b/src/Futhark/CodeGen/Backends/CCUDA.hs
--- a/src/Futhark/CodeGen/Backends/CCUDA.hs
+++ b/src/Futhark/CodeGen/Backends/CCUDA.hs
@@ -71,8 +71,8 @@
           GC.opsCompiler = callKernel,
           GC.opsFatMemory = True,
           GC.opsCritical =
-            ( [C.citems|CUDA_SUCCEED(cuCtxPushCurrent(ctx->cuda.cu_ctx));|],
-              [C.citems|CUDA_SUCCEED(cuCtxPopCurrent(&ctx->cuda.cu_ctx));|]
+            ( [C.citems|CUDA_SUCCEED_FATAL(cuCtxPushCurrent(ctx->cuda.cu_ctx));|],
+              [C.citems|CUDA_SUCCEED_FATAL(cuCtxPopCurrent(&ctx->cuda.cu_ctx));|]
             )
         }
     cuda_includes =
@@ -140,7 +140,7 @@
   GC.item
     [C.citem|{$ty:t $id:val' = $exp:val;
                   $items:bef
-                  CUDA_SUCCEED(
+                  CUDA_SUCCEED_OR_RETURN(
                     cuMemcpyHtoD($exp:mem + $exp:idx * sizeof($ty:t),
                                  &$id:val',
                                  sizeof($ty:t)));
@@ -159,7 +159,7 @@
        $ty:t $id:val;
        {
        $items:bef
-       CUDA_SUCCEED(
+       CUDA_SUCCEED_OR_RETURN(
           cuMemcpyDtoH(&$id:val,
                        $exp:mem + $exp:idx * sizeof($ty:t),
                        sizeof($ty:t)));
@@ -173,13 +173,13 @@
 
 allocateCUDABuffer :: GC.Allocate OpenCL ()
 allocateCUDABuffer mem size tag "device" =
-  GC.stm [C.cstm|CUDA_SUCCEED(cuda_alloc(&ctx->cuda, $exp:size, $exp:tag, &$exp:mem));|]
+  GC.stm [C.cstm|CUDA_SUCCEED_OR_RETURN(cuda_alloc(&ctx->cuda, $exp:size, $exp:tag, &$exp:mem));|]
 allocateCUDABuffer _ _ _ space =
   error $ "Cannot allocate in '" ++ space ++ "' memory space."
 
 deallocateCUDABuffer :: GC.Deallocate OpenCL ()
 deallocateCUDABuffer mem tag "device" =
-  GC.stm [C.cstm|CUDA_SUCCEED(cuda_free(&ctx->cuda, $exp:mem, $exp:tag));|]
+  GC.stm [C.cstm|CUDA_SUCCEED_OR_RETURN(cuda_free(&ctx->cuda, $exp:mem, $exp:tag));|]
 deallocateCUDABuffer _ _ space =
   error $ "Cannot deallocate in '" ++ space ++ "' memory space."
 
@@ -190,7 +190,7 @@
   GC.item
     [C.citem|{
                 $items:bef
-                CUDA_SUCCEED(
+                CUDA_SUCCEED_OR_RETURN(
                   $id:fn($exp:dstmem + $exp:dstidx,
                          $exp:srcmem + $exp:srcidx,
                          $exp:nbytes));
@@ -227,10 +227,10 @@
     [C.cstm|{
     ctx->$id:name.references = NULL;
     ctx->$id:name.size = 0;
-    CUDA_SUCCEED(cuMemAlloc(&ctx->$id:name.mem,
+    CUDA_SUCCEED_FATAL(cuMemAlloc(&ctx->$id:name.mem,
                             ($int:num_elems > 0 ? $int:num_elems : 1)*sizeof($ty:ct)));
     if ($int:num_elems > 0) {
-      CUDA_SUCCEED(cuMemcpyHtoD(ctx->$id:name.mem, $id:name_realtype,
+      CUDA_SUCCEED_FATAL(cuMemcpyHtoD(ctx->$id:name.mem, $id:name_realtype,
                                 $int:num_elems*sizeof($ty:ct)));
     }
   }|]
@@ -330,7 +330,7 @@
         $id:time_start = get_wall_time();
       }
       $items:bef
-      CUDA_SUCCEED(
+      CUDA_SUCCEED_OR_RETURN(
         cuLaunchKernel(ctx->$id:kernel_name,
                        grid[0], grid[1], grid[2],
                        $exp:block_x, $exp:block_y, $exp:block_z,
@@ -338,7 +338,7 @@
                        $id:args_arr, NULL));
       $items:aft
       if (ctx->debugging) {
-        CUDA_SUCCEED(cuCtxSynchronize());
+        CUDA_SUCCEED_FATAL(cuCtxSynchronize());
         $id:time_end = get_wall_time();
         fprintf(ctx->log, "Kernel %s runtime: %ldus\n",
                 $string:(pretty kernel_name), $id:time_end - $id:time_start);
diff --git a/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs b/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs
--- a/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs
+++ b/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs
@@ -41,12 +41,12 @@
         pevents = cuda_get_events(&ctx->cuda,
                                   &ctx->$id:(kernelRuns name),
                                   &ctx->$id:(kernelRuntime name));
-        CUDA_SUCCEED(cudaEventRecord(pevents[0], 0));
+        CUDA_SUCCEED_FATAL(cudaEventRecord(pevents[0], 0));
       }
       |],
     [C.citems|
       if (pevents != NULL) {
-        CUDA_SUCCEED(cudaEventRecord(pevents[1], 0));
+        CUDA_SUCCEED_FATAL(cudaEventRecord(pevents[1], 0));
       }
       |]
   )
@@ -77,7 +77,7 @@
   cfg <- generateConfigFuns sizes
   generateContextFuns cfg cost_centres kernels sizes failures
 
-  GC.profileReport [C.citem|CUDA_SUCCEED(cuda_tally_profiling_records(&ctx->cuda));|]
+  GC.profileReport [C.citem|CUDA_SUCCEED_FATAL(cuda_tally_profiling_records(&ctx->cuda));|]
   mapM_ GC.profileReport $ costCentreReport $ cost_centres ++ M.keys kernels
   where
     cuda_h = $(embedStringFile "rts/c/cuda.h")
@@ -309,10 +309,10 @@
 
       forKernel name =
         ( [C.csdecl|typename CUfunction $id:name;|],
-          [C.cstm|CUDA_SUCCEED(cuModuleGetFunction(
-                                &ctx->$id:name,
-                                ctx->cuda.module,
-                                $string:(pretty (C.toIdent name mempty))));|]
+          [C.cstm|CUDA_SUCCEED_FATAL(cuModuleGetFunction(
+                                     &ctx->$id:name,
+                                     ctx->cuda.module,
+                                     $string:(pretty (C.toIdent name mempty))));|]
         ) :
         forCostCentre name
 
@@ -384,10 +384,10 @@
                  cuda_setup(&ctx->cuda, cuda_program, cfg->nvrtc_opts);
 
                  typename int32_t no_error = -1;
-                 CUDA_SUCCEED(cuMemAlloc(&ctx->global_failure, sizeof(no_error)));
-                 CUDA_SUCCEED(cuMemcpyHtoD(ctx->global_failure, &no_error, sizeof(no_error)));
+                 CUDA_SUCCEED_FATAL(cuMemAlloc(&ctx->global_failure, sizeof(no_error)));
+                 CUDA_SUCCEED_FATAL(cuMemcpyHtoD(ctx->global_failure, &no_error, sizeof(no_error)));
                  // The +1 is to avoid zero-byte allocations.
-                 CUDA_SUCCEED(cuMemAlloc(&ctx->global_failure_args, sizeof(int64_t)*($int:max_failure_args+1)));
+                 CUDA_SUCCEED_FATAL(cuMemAlloc(&ctx->global_failure_args, sizeof(int64_t)*($int:max_failure_args+1)));
 
                  $stms:init_kernel_fields
 
@@ -396,7 +396,7 @@
 
                  init_constants(ctx);
                  // Clear the free list of any deallocations that occurred while initialising constants.
-                 CUDA_SUCCEED(cuda_free_all(&ctx->cuda));
+                 CUDA_SUCCEED_FATAL(cuda_free_all(&ctx->cuda));
 
                  futhark_context_sync(ctx);
 
@@ -417,12 +417,12 @@
   GC.publicDef_ "context_sync" GC.MiscDecl $ \s ->
     ( [C.cedecl|int $id:s(struct $id:ctx* ctx);|],
       [C.cedecl|int $id:s(struct $id:ctx* ctx) {
-                 CUDA_SUCCEED(cuCtxPushCurrent(ctx->cuda.cu_ctx));
-                 CUDA_SUCCEED(cuCtxSynchronize());
+                 CUDA_SUCCEED_OR_RETURN(cuCtxPushCurrent(ctx->cuda.cu_ctx));
+                 CUDA_SUCCEED_OR_RETURN(cuCtxSynchronize());
                  if (ctx->failure_is_an_option) {
                    // Check for any delayed error.
                    typename int32_t failure_idx;
-                   CUDA_SUCCEED(
+                   CUDA_SUCCEED_OR_RETURN(
                      cuMemcpyDtoH(&failure_idx,
                                   ctx->global_failure,
                                   sizeof(int32_t)));
@@ -432,13 +432,13 @@
                      // We have to clear global_failure so that the next entry point
                      // is not considered a failure from the start.
                      typename int32_t no_failure = -1;
-                     CUDA_SUCCEED(
+                     CUDA_SUCCEED_OR_RETURN(
                        cuMemcpyHtoD(ctx->global_failure,
                                     &no_failure,
                                     sizeof(int32_t)));
 
                      typename int64_t args[$int:max_failure_args+1];
-                     CUDA_SUCCEED(
+                     CUDA_SUCCEED_OR_RETURN(
                        cuMemcpyDtoH(&args,
                                     ctx->global_failure_args,
                                     sizeof(args)));
@@ -448,12 +448,12 @@
                      return 1;
                    }
                  }
-                 CUDA_SUCCEED(cuCtxPopCurrent(&ctx->cuda.cu_ctx));
+                 CUDA_SUCCEED_OR_RETURN(cuCtxPopCurrent(&ctx->cuda.cu_ctx));
                  return 0;
                }|]
     )
 
   GC.onClear
     [C.citem|if (ctx->error == NULL) {
-               CUDA_SUCCEED(cuda_free_all(&ctx->cuda));
+               CUDA_SUCCEED_NONFATAL(cuda_free_all(&ctx->cuda));
              }|]
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
@@ -81,7 +81,8 @@
 where
 
 import Control.Monad.Identity
-import Control.Monad.RWS
+import Control.Monad.Reader
+import Control.Monad.State
 import Data.Bifunctor (first)
 import qualified Data.DList as DL
 import Data.FileEmbed
@@ -110,7 +111,8 @@
     compCtxFields :: DL.DList (C.Id, C.Type, Maybe C.Exp),
     compProfileItems :: DL.DList C.BlockItem,
     compClearItems :: DL.DList C.BlockItem,
-    compDeclaredMem :: [(VName, Space)]
+    compDeclaredMem :: [(VName, Space)],
+    compItems :: DL.DList C.BlockItem
   }
 
 newCompilerState :: VNameSource -> s -> CompilerState s
@@ -127,7 +129,8 @@
       compCtxFields = mempty,
       compProfileItems = mempty,
       compClearItems = mempty,
-      compDeclaredMem = mempty
+      compDeclaredMem = mempty,
+      compItems = mempty
     }
 
 -- | In which part of the header file we put the declaration.  This is
@@ -288,17 +291,6 @@
     envCachedMem :: M.Map C.Exp VName
   }
 
-newtype CompilerAcc op s = CompilerAcc
-  { accItems :: DL.DList C.BlockItem
-  }
-
-instance Semigroup (CompilerAcc op s) where
-  CompilerAcc items1 <> CompilerAcc items2 =
-    CompilerAcc (items1 <> items2)
-
-instance Monoid (CompilerAcc op s) where
-  mempty = CompilerAcc mempty
-
 envOpCompiler :: CompilerEnv op s -> OpCompiler op s
 envOpCompiler = opsCompiler . envOperations
 
@@ -360,20 +352,13 @@
 contextFinalInits = gets compInit
 
 newtype CompilerM op s a
-  = CompilerM
-      ( RWS
-          (CompilerEnv op s)
-          (CompilerAcc op s)
-          (CompilerState s)
-          a
-      )
+  = CompilerM (ReaderT (CompilerEnv op s) (State (CompilerState s)) a)
   deriving
     ( Functor,
       Applicative,
       Monad,
       MonadState (CompilerState s),
-      MonadReader (CompilerEnv op s),
-      MonadWriter (CompilerAcc op s)
+      MonadReader (CompilerEnv op s)
     )
 
 instance MonadFreshNames (CompilerM op s) where
@@ -387,8 +372,9 @@
   CompilerM op s a ->
   (a, CompilerState s)
 runCompilerM ops src userstate (CompilerM m) =
-  let (x, s, _) = runRWS m (CompilerEnv ops mempty) (newCompilerState src userstate)
-   in (x, s)
+  runState
+    (runReaderT m (CompilerEnv ops mempty))
+    (newCompilerState src userstate)
 
 getUserState :: CompilerM op s s
 getUserState = gets compUserState
@@ -405,12 +391,13 @@
 collect m = snd <$> collect' m
 
 collect' :: CompilerM op s a -> CompilerM op s (a, [C.BlockItem])
-collect' m = pass $ do
-  (x, w) <- listen m
-  return
-    ( (x, DL.toList $ accItems w),
-      const w {accItems = mempty}
-    )
+collect' m = do
+  old <- gets compItems
+  modify $ \s -> s {compItems = mempty}
+  x <- m
+  new <- gets compItems
+  modify $ \s -> s {compItems = old}
+  pure (x, DL.toList new)
 
 -- | Used when we, inside an existing 'CompilerM' action, want to
 -- generate code for a new function.  Use this so that the compiler
@@ -429,10 +416,10 @@
       | otherwise = env {envCachedMem = mempty}
 
 item :: C.BlockItem -> CompilerM op s ()
-item x = tell $ mempty {accItems = DL.singleton x}
+item x = modify $ \s -> s {compItems = DL.snoc (compItems s) x}
 
 items :: [C.BlockItem] -> CompilerM op s ()
-items = mapM_ item
+items xs = modify $ \s -> s {compItems = DL.append (compItems s) (DL.fromList xs)}
 
 fatMemory :: Space -> CompilerM op s Bool
 fatMemory ScalarSpace {} = return False
@@ -1245,16 +1232,16 @@
   [C.BlockItem] ->
   Name ->
   Function op ->
-  CompilerM op s C.Definition
-onEntryPoint get_consts fname (Function _ outputs inputs _ results args) = do
+  CompilerM op s (Maybe C.Definition)
+onEntryPoint _ _ (Function Nothing _ _ _ _ _) = pure Nothing
+onEntryPoint get_consts fname (Function (Just ename) outputs inputs _ results args) = do
   let out_args = map (\p -> [C.cexp|&$id:(paramName p)|]) outputs
       in_args = map (\p -> [C.cexp|$id:(paramName p)|]) inputs
 
   inputdecls <- collect $ mapM_ stubParam inputs
   outputdecls <- collect $ mapM_ stubParam outputs
 
-  let entry_point_name = nameToString fname
-  entry_point_function_name <- publicName $ "entry_" ++ entry_point_name
+  entry_point_function_name <- publicName $ "entry_" ++ nameToString ename
 
   (inputs', unpack_entry_inputs) <- prepareEntryInputs args
   let (entry_point_input_params, entry_point_input_checks) = unzip inputs'
@@ -1293,7 +1280,7 @@
 
   ops <- asks envOperations
 
-  return
+  pure . Just $
     [C.cedecl|
        int $id:entry_point_function_name
            ($ty:ctx_ty *ctx,
@@ -1499,7 +1486,7 @@
       }
   where
     Definitions consts (Functions funs) = prog
-    entry_funs = filter (functionEntry . snd) funs
+    entry_funs = filter (isJust . functionEntry . snd) funs
 
     compileProg' = do
       (memstructs, memfuns, memreport) <- unzip3 <$> mapM defineMemorySpace spaces
@@ -1513,7 +1500,7 @@
 
       mapM_ earlyDecl memstructs
       entry_points <-
-        mapM (uncurry (onEntryPoint get_consts)) $ filter (functionEntry . snd) funs
+        catMaybes <$> mapM (uncurry (onEntryPoint get_consts)) funs
 
       extra
 
@@ -1833,6 +1820,8 @@
   where
     compileLeaf (ScalarVar src) =
       return [C.cexp|$id:src|]
+    compileLeaf (Index _ _ Unit __ _) =
+      return $ compilePrimValue UnitValue
     compileLeaf (Index src (Count iexp) restype DefaultSpace vol) = do
       src' <- rawMem src
       derefPointer src'
@@ -1923,6 +1912,13 @@
   args' <- mapM (compilePrimExp f) args
   return [C.cexp|$id:(funName (nameFromString h))($args:args')|]
 
+linearCode :: Code op -> [Code op]
+linearCode = reverse . go []
+  where
+    go acc (x :>>: y) =
+      go (go acc x) y
+    go acc x = x : acc
+
 compileCode :: Code op -> CompilerM op s ()
 compileCode (Op op) =
   join $ asks envOpCompiler <*> pure op
@@ -1951,13 +1947,18 @@
     [C.cstm|if (ctx->debugging) {
           fprintf(ctx->log, "%s\n", $exp:s);
        }|]
-compileCode c
-  | Just (name, vol, t, e, c') <- declareAndSet c = do
-    let ct = primTypeToCType t
-    e' <- compileExp e
-    item [C.citem|$tyquals:(volQuals vol) $ty:ct $id:name = $exp:e';|]
-    compileCode c'
-compileCode (c1 :>>: c2) = compileCode c1 >> compileCode c2
+-- :>>: is treated in a special way to detect declare-set pairs in
+-- order to generate prettier code.
+compileCode (c1 :>>: c2) = go (linearCode (c1 :>>: c2))
+  where
+    go (DeclareScalar name vol t : SetScalar dest e : code)
+      | name == dest = do
+        let ct = primTypeToCType t
+        e' <- compileExp e
+        item [C.citem|$tyquals:(volQuals vol) $ty:ct $id:name = $exp:e';|]
+        go code
+    go (x : xs) = compileCode x >> go xs
+    go [] = pure ()
 compileCode (Assert e msg (loc, locs)) = do
   e' <- compileExp e
   err <-
@@ -2112,10 +2113,7 @@
 blockScope' :: CompilerM op s a -> CompilerM op s (a, [C.BlockItem])
 blockScope' m = do
   old_allocs <- gets compDeclaredMem
-  (x, xs) <- pass $ do
-    (x, w) <- listen m
-    let xs = DL.toList $ accItems w
-    return ((x, xs), const mempty)
+  (x, xs) <- collect' m
   new_allocs <- gets $ filter (`notElem` old_allocs) . compDeclaredMem
   modify $ \s -> s {compDeclaredMem = old_allocs}
   releases <- collect $ mapM_ (uncurry unRefMem) new_allocs
@@ -2138,21 +2136,6 @@
       setMem [C.cexp|*$exp:p|] name space
     setRetVal' p (ScalarParam name _) =
       stm [C.cstm|*$exp:p = $id:name;|]
-
-declareAndSet :: Code op -> Maybe (VName, Volatility, PrimType, Exp, Code op)
-declareAndSet code = do
-  (DeclareScalar name vol t, code') <- nextCode code
-  (SetScalar dest e, code'') <- nextCode code'
-  guard $ name == dest
-  Just (name, vol, t, e, code'')
-
-nextCode :: Code op -> Maybe (Code op, Code op)
-nextCode (x :>>: y)
-  | Just (x_a, x_b) <- nextCode x =
-    Just (x_a, x_b <> y)
-  | otherwise =
-    Just (x, y)
-nextCode _ = Nothing
 
 assignmentOperator :: BinOp -> Maybe (VName -> C.Exp -> C.Exp)
 assignmentOperator Add {} = Just $ \d e -> [C.cexp|$id:d += $exp:e|]
diff --git a/src/Futhark/CodeGen/Backends/GenericC/CLI.hs b/src/Futhark/CodeGen/Backends/GenericC/CLI.hs
--- a/src/Futhark/CodeGen/Backends/GenericC/CLI.hs
+++ b/src/Futhark/CodeGen/Backends/GenericC/CLI.hs
@@ -14,6 +14,7 @@
 
 import Data.FileEmbed
 import Data.List (unzip5)
+import Data.Maybe
 import Futhark.CodeGen.Backends.GenericC.Options
 import Futhark.CodeGen.Backends.SimpleRep
 import Futhark.CodeGen.ImpCode
@@ -305,8 +306,9 @@
 cliEntryPoint ::
   Name ->
   FunctionT a ->
-  (C.Definition, C.Initializer)
-cliEntryPoint fname (Function _ _ _ _ results args) =
+  Maybe (C.Definition, C.Initializer)
+cliEntryPoint fname fun@(Function _ _ _ _ results args) = do
+  entry_point_name <- nameToString <$> functionEntry fun
   let (input_items, pack_input, free_input, free_parsed, input_args) =
         unzip5 $ readInputs args
 
@@ -319,7 +321,6 @@
       sync_ctx = "futhark_context_sync" :: Name
       error_ctx = "futhark_context_get_error" :: Name
 
-      entry_point_name = nameToString fname
       cli_entry_point_function_name = "futrts_cli_entry_" ++ entry_point_name
       entry_point_function_name = "futhark_entry_" ++ entry_point_name
 
@@ -330,85 +331,86 @@
 
       run_it =
         [C.citems|
-                  int r;
-                  // Run the program once.
-                  $stms:pack_input
-                  if ($id:sync_ctx(ctx) != 0) {
-                    futhark_panic(1, "%s", $id:error_ctx(ctx));
-                  };
-                  // Only profile last run.
-                  if (profile_run) {
-                    $id:unpause_profiling(ctx);
-                  }
-                  t_start = get_wall_time();
-                  r = $id:entry_point_function_name(ctx,
-                                                    $args:(map addrOf output_vals),
-                                                    $args:input_args);
-                  if (r != 0) {
-                    futhark_panic(1, "%s", $id:error_ctx(ctx));
-                  }
-                  if ($id:sync_ctx(ctx) != 0) {
-                    futhark_panic(1, "%s", $id:error_ctx(ctx));
-                  };
-                  if (profile_run) {
-                    $id:pause_profiling(ctx);
-                  }
-                  t_end = get_wall_time();
-                  long int elapsed_usec = t_end - t_start;
-                  if (time_runs && runtime_file != NULL) {
-                    fprintf(runtime_file, "%lld\n", (long long) elapsed_usec);
-                    fflush(runtime_file);
-                  }
-                  $stms:free_input
-                |]
-   in ( [C.cedecl|
-  static void $id:cli_entry_point_function_name($ty:ctx_ty *ctx) {
-    typename int64_t t_start, t_end;
-    int time_runs = 0, profile_run = 0;
+                int r;
+                // Run the program once.
+                $stms:pack_input
+                if ($id:sync_ctx(ctx) != 0) {
+                  futhark_panic(1, "%s", $id:error_ctx(ctx));
+                };
+                // Only profile last run.
+                if (profile_run) {
+                  $id:unpause_profiling(ctx);
+                }
+                t_start = get_wall_time();
+                r = $id:entry_point_function_name(ctx,
+                                                  $args:(map addrOf output_vals),
+                                                  $args:input_args);
+                if (r != 0) {
+                  futhark_panic(1, "%s", $id:error_ctx(ctx));
+                }
+                if ($id:sync_ctx(ctx) != 0) {
+                  futhark_panic(1, "%s", $id:error_ctx(ctx));
+                };
+                if (profile_run) {
+                  $id:pause_profiling(ctx);
+                }
+                t_end = get_wall_time();
+                long int elapsed_usec = t_end - t_start;
+                if (time_runs && runtime_file != NULL) {
+                  fprintf(runtime_file, "%lld\n", (long long) elapsed_usec);
+                  fflush(runtime_file);
+                }
+                $stms:free_input
+              |]
+  Just
+    ( [C.cedecl|
+   static void $id:cli_entry_point_function_name($ty:ctx_ty *ctx) {
+     typename int64_t t_start, t_end;
+     int time_runs = 0, profile_run = 0;
 
-    // We do not want to profile all the initialisation.
-    $id:pause_profiling(ctx);
+     // We do not want to profile all the initialisation.
+     $id:pause_profiling(ctx);
 
-    // Declare and read input.
-    set_binary_mode(stdin);
-    $items:(mconcat input_items)
+     // Declare and read input.
+     set_binary_mode(stdin);
+     $items:(mconcat input_items)
 
-    if (end_of_input(stdin) != 0) {
-      futhark_panic(1, "Expected EOF on stdin after reading input for %s.\n", $string:(quote (pretty fname)));
-    }
+     if (end_of_input(stdin) != 0) {
+       futhark_panic(1, "Expected EOF on stdin after reading input for %s.\n", $string:(quote (pretty fname)));
+     }
 
-    $items:output_decls
+     $items:output_decls
 
-    // Warmup run
-    if (perform_warmup) {
-      $items:run_it
-      $stms:free_outputs
-    }
-    time_runs = 1;
-    // Proper run.
-    for (int run = 0; run < num_runs; run++) {
-      // Only profile last run.
-      profile_run = run == num_runs -1;
-      $items:run_it
-      if (run < num_runs-1) {
-        $stms:free_outputs
-      }
-    }
+     // Warmup run
+     if (perform_warmup) {
+       $items:run_it
+       $stms:free_outputs
+     }
+     time_runs = 1;
+     // Proper run.
+     for (int run = 0; run < num_runs; run++) {
+       // Only profile last run.
+       profile_run = run == num_runs -1;
+       $items:run_it
+       if (run < num_runs-1) {
+         $stms:free_outputs
+       }
+     }
 
-    // Free the parsed input.
-    $stms:free_parsed
+     // Free the parsed input.
+     $stms:free_parsed
 
-    // Print the final result.
-    if (binary_output) {
-      set_binary_mode(stdout);
-    }
-    $stms:printstms
+     // Print the final result.
+     if (binary_output) {
+       set_binary_mode(stdout);
+     }
+     $stms:printstms
 
-    $stms:free_outputs
-  }|],
-        [C.cinit|{ .name = $string:entry_point_name,
-                      .fun = $id:cli_entry_point_function_name }|]
-      )
+     $stms:free_outputs
+   }|],
+      [C.cinit|{ .name = $string:entry_point_name,
+                       .fun = $id:cli_entry_point_function_name }|]
+    )
 
 {-# NOINLINE cliDefs #-}
 
@@ -421,7 +423,7 @@
       option_parser =
         generateOptionParser "parse_options" $ genericOptions ++ options
       (cli_entry_point_decls, entry_point_inits) =
-        unzip $ map (uncurry cliEntryPoint) funs
+        unzip $ mapMaybe (uncurry cliEntryPoint) funs
    in [C.cunit|
 $esc:("#include <getopt.h>")
 $esc:("#include <ctype.h>")
diff --git a/src/Futhark/CodeGen/Backends/GenericC/Server.hs b/src/Futhark/CodeGen/Backends/GenericC/Server.hs
--- a/src/Futhark/CodeGen/Backends/GenericC/Server.hs
+++ b/src/Futhark/CodeGen/Backends/GenericC/Server.hs
@@ -15,6 +15,7 @@
 import Data.Bifunctor (first, second)
 import Data.FileEmbed
 import qualified Data.Map as M
+import Data.Maybe
 import Futhark.CodeGen.Backends.GenericC.Options
 import Futhark.CodeGen.Backends.SimpleRep
 import Futhark.CodeGen.ImpCode
@@ -184,17 +185,15 @@
 
 entryTypeBoilerplate :: Functions a -> ([C.Initializer], [C.Definition])
 entryTypeBoilerplate (Functions funs) =
-  second concat $
-    unzip $
-      M.elems $
-        M.fromList $
-          map valueDescBoilerplate $
-            concatMap (functionExternalValues . snd) $
-              filter (functionEntry . snd) funs
+  second concat . unzip . M.elems . M.fromList . map valueDescBoilerplate
+    . concatMap (functionExternalValues . snd)
+    . filter (isJust . functionEntry . snd)
+    $ funs
 
-oneEntryBoilerplate :: (Name, Function a) -> ([C.Definition], C.Initializer)
-oneEntryBoilerplate (name, fun) =
-  let entry_f = "futhark_entry_" ++ pretty name
+oneEntryBoilerplate :: (Name, Function a) -> Maybe ([C.Definition], C.Initializer)
+oneEntryBoilerplate (name, fun) = do
+  ename <- functionEntry fun
+  let entry_f = "futhark_entry_" ++ pretty ename
       call_f = "call_" ++ pretty name
       out_types = functionResult fun
       in_types = functionArgs fun
@@ -206,7 +205,8 @@
       (in_items, in_args)
         | null in_types = ([C.citems|(void)ins;|], mempty)
         | otherwise = unzip $ zipWith loadIn [0 ..] in_types
-   in ( [C.cunit|
+  pure
+    ( [C.cunit|
                 struct type* $id:out_types_name[] = {
                   $inits:(map typeStructInit out_types),
                   NULL
@@ -221,13 +221,13 @@
                   return $id:entry_f(ctx, $args:out_args, $args:in_args);
                 }
                 |],
-        [C.cinit|{
-            .name = $string:(pretty name),
+      [C.cinit|{
+            .name = $string:(pretty ename),
             .f = $id:call_f,
             .in_types = $id:in_types_name,
             .out_types = $id:out_types_name
             }|]
-      )
+    )
   where
     typeStructInit t = [C.cinit|&$id:(typeStructName t)|]
 
@@ -245,7 +245,7 @@
 
 entryBoilerplate :: Functions a -> ([C.Definition], [C.Initializer])
 entryBoilerplate (Functions funs) =
-  first concat $ unzip $ map oneEntryBoilerplate $ filter (functionEntry . snd) funs
+  first concat $ unzip $ mapMaybe oneEntryBoilerplate funs
 
 mkBoilerplate ::
   Functions a ->
diff --git a/src/Futhark/CodeGen/Backends/GenericPython.hs b/src/Futhark/CodeGen/Backends/GenericPython.hs
--- a/src/Futhark/CodeGen/Backends/GenericPython.hs
+++ b/src/Futhark/CodeGen/Backends/GenericPython.hs
@@ -327,7 +327,7 @@
 opaqueDefs :: Imp.Functions a -> M.Map String [PyExp]
 opaqueDefs (Imp.Functions funs) =
   mconcat . map evd . concatMap (functionExternalValues . snd) $
-    filter (Imp.functionEntry . snd) funs
+    filter (isJust . Imp.functionEntry . snd) funs
   where
     evd Imp.TransparentValue {} = mempty
     evd (Imp.OpaqueValue name vds) =
@@ -365,28 +365,23 @@
 compileProg mode class_name constructor imports defines ops userstate sync options prog = do
   src <- getNameSource
   let prog' = runCompilerM ops src userstate compileProg'
-      maybe_shebang =
-        case mode of
-          ToLibrary -> ""
-          _ -> "#!/usr/bin/env python3\n"
   return $
-    maybe_shebang
-      ++ pretty
-        ( PyProg $
-            imports
-              ++ [ Import "argparse" Nothing,
-                   Assign (Var "sizes") $ Dict []
-                 ]
-              ++ defines
-              ++ [ Escape pyValues,
-                   Escape pyFunctions,
-                   Escape pyPanic,
-                   Escape pyTuning,
-                   Escape pyUtility,
-                   Escape pyServer
-                 ]
-              ++ prog'
-        )
+    pretty
+      ( PyProg $
+          imports
+            ++ [ Import "argparse" Nothing,
+                 Assign (Var "sizes") $ Dict []
+               ]
+            ++ defines
+            ++ [ Escape pyValues,
+                 Escape pyFunctions,
+                 Escape pyPanic,
+                 Escape pyTuning,
+                 Escape pyUtility,
+                 Escape pyServer
+               ]
+            ++ prog'
+      )
   where
     Imp.Definitions consts (Imp.Functions funs) = prog
     compileProg' = withConstantSubsts consts $ do
@@ -400,10 +395,7 @@
       case mode of
         ToLibrary -> do
           (entry_points, entry_point_types) <-
-            unzip
-              <$> mapM
-                (compileEntryFun sync DoNotReturnTiming)
-                (filter (Imp.functionEntry . snd) funs)
+            unzip . catMaybes <$> mapM (compileEntryFun sync DoNotReturnTiming) funs
           return
             [ ClassDef $
                 Class class_name $
@@ -415,10 +407,7 @@
             ]
         ToServer -> do
           (entry_points, entry_point_types) <-
-            unzip
-              <$> mapM
-                (compileEntryFun sync ReturnTiming)
-                (filter (Imp.functionEntry . snd) funs)
+            unzip . catMaybes <$> mapM (compileEntryFun sync ReturnTiming) funs
           return $
             parse_options_server
               ++ [ ClassDef
@@ -437,10 +426,7 @@
         ToExecutable -> do
           let classinst = Assign (Var "self") $ simpleCall class_name []
           (entry_point_defs, entry_point_names, entry_points) <-
-            unzip3
-              <$> mapM
-                (callEntryFun sync)
-                (filter (Imp.functionEntry . snd) funs)
+            unzip3 . catMaybes <$> mapM (callEntryFun sync) funs
           return $
             parse_options_executable
               ++ ClassDef
@@ -794,8 +780,7 @@
   CompilerM
     op
     s
-    ( String,
-      [String],
+    ( [String],
       [PyStmt],
       [PyStmt],
       [PyStmt],
@@ -857,8 +842,7 @@
         ]
 
   return
-    ( nameToString fname,
-      map extValueDescName args,
+    ( map extValueDescName args,
       prepareIn,
       call argexps_lib,
       call argexps_bin,
@@ -891,40 +875,43 @@
   [PyStmt] ->
   ReturnTiming ->
   (Name, Imp.Function op) ->
-  CompilerM op s (PyFunDef, (PyExp, PyExp))
-compileEntryFun sync timing entry = do
-  (fname', params, prepareIn, body_lib, _, prepareOut, res, _) <- prepareEntry entry
-  let (maybe_sync, ret) =
-        case timing of
-          DoNotReturnTiming ->
-            ( [],
-              Return $ tupleOrSingle $ map snd res
-            )
-          ReturnTiming ->
-            ( sync,
-              Return $
-                Tuple
-                  [ Var "runtime",
-                    tupleOrSingle $ map snd res
-                  ]
-            )
-      (pts, rts) = entryTypes $ snd entry
+  CompilerM op s (Maybe (PyFunDef, (PyExp, PyExp)))
+compileEntryFun sync timing entry
+  | Just ename <- Imp.functionEntry $ snd entry = do
+    (params, prepareIn, body_lib, _, prepareOut, res, _) <- prepareEntry entry
+    let (maybe_sync, ret) =
+          case timing of
+            DoNotReturnTiming ->
+              ( [],
+                Return $ tupleOrSingle $ map snd res
+              )
+            ReturnTiming ->
+              ( sync,
+                Return $
+                  Tuple
+                    [ Var "runtime",
+                      tupleOrSingle $ map snd res
+                    ]
+              )
+        (pts, rts) = entryTypes $ snd entry
 
-      do_run =
-        Assign (Var "time_start") (simpleCall "time.time" []) :
-        body_lib ++ maybe_sync
-          ++ [ Assign (Var "runtime") $
-                 BinOp
-                   "-"
-                   (toMicroseconds (simpleCall "time.time" []))
-                   (toMicroseconds (Var "time_start"))
-             ]
+        do_run =
+          Assign (Var "time_start") (simpleCall "time.time" []) :
+          body_lib ++ maybe_sync
+            ++ [ Assign (Var "runtime") $
+                   BinOp
+                     "-"
+                     (toMicroseconds (simpleCall "time.time" []))
+                     (toMicroseconds (Var "time_start"))
+               ]
 
-  return
-    ( Def fname' ("self" : params) $
-        prepareIn ++ do_run ++ prepareOut ++ sync ++ [ret],
-      (String fname', Tuple [List (map String pts), List (map String rts)])
-    )
+    pure $
+      Just
+        ( Def (nameToString ename) ("self" : params) $
+            prepareIn ++ do_run ++ prepareOut ++ sync ++ [ret],
+          (String (nameToString ename), Tuple [List (map String pts), List (map String rts)])
+        )
+  | otherwise = pure Nothing
 
 entryTypes :: Imp.Function op -> ([String], [String])
 entryTypes func =
@@ -940,9 +927,10 @@
 callEntryFun ::
   [PyStmt] ->
   (Name, Imp.Function op) ->
-  CompilerM op s (PyFunDef, String, PyExp)
-callEntryFun pre_timing entry@(fname, Imp.Function _ _ _ _ _ decl_args) = do
-  (_, _, prepare_in, _, body_bin, _, res, prepare_run) <- prepareEntry entry
+  CompilerM op s (Maybe (PyFunDef, String, PyExp))
+callEntryFun _ (_, Imp.Function Nothing _ _ _ _ _) = pure Nothing
+callEntryFun pre_timing entry@(fname, Imp.Function (Just ename) _ _ _ _ decl_args) = do
+  (_, prepare_in, _, body_bin, _, res, prepare_run) <- prepareEntry entry
 
   let str_input = map readInput decl_args
       end_of_input = [Exp $ simpleCall "end_of_input" [String $ pretty fname]]
@@ -965,15 +953,16 @@
 
   let fname' = "entry_" ++ nameToString fname
 
-  return
-    ( Def fname' [] $
-        str_input ++ end_of_input ++ prepare_in
-          ++ [Try [do_warmup_run, do_num_runs] [except']]
-          ++ [close_runtime_file]
-          ++ str_output,
-      nameToString fname,
-      Var fname'
-    )
+  pure $
+    Just
+      ( Def fname' [] $
+          str_input ++ end_of_input ++ prepare_in
+            ++ [Try [do_warmup_run, do_num_runs] [except']]
+            ++ [close_runtime_file]
+            ++ str_output,
+        nameToString ename,
+        Var fname'
+      )
 
 addTiming :: [PyStmt] -> ([PyStmt], PyStmt)
 addTiming statements =
@@ -1160,6 +1149,8 @@
   where
     compileLeaf (Imp.ScalarVar vname) =
       compileVar vname
+    compileLeaf (Imp.Index _ _ Unit _ _) =
+      return $ compilePrimValue UnitValue
     compileLeaf (Imp.Index src (Imp.Count iexp) restype (Imp.Space space) _) =
       join $
         asks envReadScalar
diff --git a/src/Futhark/CodeGen/Backends/MulticoreC.hs b/src/Futhark/CodeGen/Backends/MulticoreC.hs
--- a/src/Futhark/CodeGen/Backends/MulticoreC.hs
+++ b/src/Futhark/CodeGen/Backends/MulticoreC.hs
@@ -533,7 +533,7 @@
 
   e' <- GC.compileExp e
 
-  let lexical = lexicalMemoryUsage $ Function False [] params seq_code [] []
+  let lexical = lexicalMemoryUsage $ Function Nothing [] params seq_code [] []
 
   fstruct <-
     prepareTaskStruct "task" free_args free_ctypes retval_args retval_ctypes
@@ -558,7 +558,7 @@
   -- Generate the nested segop function if available
   fnpar_task <- case par_task of
     Just (ParallelTask nested_code nested_tid) -> do
-      let lexical_nested = lexicalMemoryUsage $ Function False [] params nested_code [] []
+      let lexical_nested = lexicalMemoryUsage $ Function Nothing [] params nested_code [] []
       fnpar_task <- generateParLoopFn lexical_nested (name ++ "_nested_task") nested_code fstruct free retval nested_tid nsubtask
       GC.stm [C.cstm|$id:ftask_name.nested_fn = $id:fnpar_task;|]
       return $ zip [fnpar_task] [True]
@@ -583,7 +583,7 @@
 
   let lexical =
         lexicalMemoryUsage $
-          Function False [] free (prebody <> body) [] []
+          Function Nothing [] free (prebody <> body) [] []
 
   fstruct <-
     prepareTaskStruct (s' ++ "_parloop_struct") free_args free_ctypes mempty mempty
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
@@ -102,9 +102,11 @@
   { defConsts :: Constants a,
     defFuns :: Functions a
   }
+  deriving (Show)
 
 -- | A collection of imperative functions.
 newtype Functions a = Functions [(Name, Function a)]
+  deriving (Show)
 
 instance Semigroup (Functions a) where
   Functions x <> Functions y = Functions $ x ++ y
@@ -120,6 +122,7 @@
     -- contain declarations of the names defined in 'constsDecl'.
     constsInit :: Code a
   }
+  deriving (Show)
 
 -- | Since the core language does not care for signedness, but the
 -- source language does, entry point input/output information has
@@ -154,7 +157,7 @@
 -- and results.  The latter are only used if the function is an entry
 -- point.
 data FunctionT a = Function
-  { functionEntry :: Bool,
+  { functionEntry :: Maybe Name,
     functionOutput :: [Param],
     functionInput :: [Param],
     functionBody :: Code a,
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
@@ -91,6 +91,7 @@
     dPrimV_,
     dPrimV,
     dPrimVE,
+    dIndexSpace,
     sFor,
     sWhile,
     sComment,
@@ -144,8 +145,10 @@
 import qualified Futhark.IR.Mem.IxFun as IxFun
 import Futhark.IR.SOACS (SOACS)
 import Futhark.Util
+import Futhark.Util.IntegralExp
 import Futhark.Util.Loc (noLoc)
 import Language.Futhark.Warnings
+import Prelude hiding (quot)
 
 -- | How to compile an t'Op'.
 type OpCompiler lore r op = Pattern lore -> Op lore -> ImpM lore r op ()
@@ -647,12 +650,17 @@
   FunDef lore ->
   ImpM lore r op ()
 compileFunDef (FunDef entry _ fname rettype params body) =
-  local (\env -> env {envFunction = Just fname}) $ do
+  local (\env -> env {envFunction = name_entry `mplus` Just fname}) $ do
     ((outparams, inparams, results, args), body') <- collect' compile
-    emitFunction fname $ Imp.Function (isJust entry) outparams inparams body' results args
+    emitFunction fname $ Imp.Function name_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
+    (name_entry, params_entry, ret_entry) = case entry of
+      Nothing ->
+        ( Nothing,
+          replicate (length params) TypeDirect,
+          replicate (length rettype) TypeDirect
+        )
+      Just (x, y, z) -> (Just x, y, z)
     compile = do
       (inparams, arrayds, args) <- compileInParams params params_entry
       (results, outparams, Destination _ dests) <- compileOutParams rettype ret_entry
@@ -1837,10 +1845,37 @@
   body <- collect $ do
     mapM_ addParam $ outputs ++ inputs
     m
-  emitFunction fname $ Imp.Function False outputs inputs body [] []
+  emitFunction fname $ Imp.Function Nothing outputs inputs body [] []
   where
     addParam (Imp.MemParam name space) =
       addVar name $ MemVar Nothing $ MemEntry space
     addParam (Imp.ScalarParam name bt) =
       addVar name $ ScalarVar Nothing $ ScalarEntry bt
     newFunction env = env {envFunction = Just fname}
+
+dSlices :: [Imp.TExp Int64] -> ImpM lore r op [Imp.TExp Int64]
+dSlices = fmap (drop 1 . snd) . dSlices'
+  where
+    dSlices' [] = pure (1, [1])
+    dSlices' (n : ns) = do
+      (prod, ns') <- dSlices' ns
+      n' <- dPrimVE "slice" $ n * prod
+      pure (n', n' : ns')
+
+-- | @dIndexSpace f dims i@ computes a list of indices into an
+-- array with dimension @dims@ given the flat index @i@.  The
+-- resulting list will have the same size as @dims@.  Intermediate
+-- results are passed to @f@.
+dIndexSpace ::
+  [(VName, Imp.TExp Int64)] ->
+  Imp.TExp Int64 ->
+  ImpM lore r op ()
+dIndexSpace vs_ds j = do
+  slices <- dSlices (map snd vs_ds)
+  loop (zip (map fst vs_ds) slices) j
+  where
+    loop ((v, size) : rest) i = do
+      dPrimV_ v (i `quot` size)
+      i' <- dPrimVE "remnant" $ i - Imp.vi64 v * size
+      loop rest i'
+    loop _ _ = pure ()
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
@@ -315,7 +315,7 @@
 
 mapTransposeFunction :: PrimType -> Imp.Function
 mapTransposeFunction bt =
-  Imp.Function False [] params transpose_code [] []
+  Imp.Function Nothing [] params transpose_code [] []
   where
     params =
       [ memparam destmem,
diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs
--- a/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs
+++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs
@@ -1145,5 +1145,7 @@
                 map Imp.vi64 $
                   map fst segment_dims ++ [subhistogram_id, bucket_id] ++ vector_ids
               )
+
+  emit $ Imp.DebugPrint "" Nothing
   where
     segment_dims = init $ unSegSpace space
diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs
--- a/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs
+++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs
@@ -28,21 +28,22 @@
       num_groups' = toInt64Exp <$> segNumGroups lvl
       group_size' = toInt64Exp <$> segGroupSize lvl
 
+  emit $ Imp.DebugPrint "\n# SegMap" Nothing
   case lvl of
     SegThread {} -> do
-      emit $ Imp.DebugPrint "\n# SegMap" Nothing
       let virt_num_groups =
             sExt32 $ product dims' `divUp` unCount group_size'
       sKernelThread "segmap" num_groups' group_size' (segFlat space) $
         virtualiseGroups (segVirt lvl) virt_num_groups $ \group_id -> do
           local_tid <- kernelLocalThreadId . kernelConstants <$> askEnv
-          let global_tid =
-                sExt64 group_id * sExt64 (unCount group_size')
-                  + sExt64 local_tid
 
-          zipWithM_ dPrimV_ is $
-            map sExt64 $ unflattenIndex (map sExt64 dims') global_tid
+          global_tid <-
+            dPrimVE "global_tid" $
+              sExt64 group_id * sExt64 (unCount group_size')
+                + sExt64 local_tid
 
+          dIndexSpace (zip is dims') global_tid
+
           sWhen (isActive $ unSegSpace space) $
             compileStms mempty (kernelBodyStms kbody) $
               zipWithM_ (compileThreadResult space) (patternElements pat) $
@@ -52,8 +53,9 @@
         let virt_num_groups = sExt32 $ product dims'
         precomputeSegOpIDs (kernelBodyStms kbody) $
           virtualiseGroups (segVirt lvl) virt_num_groups $ \group_id -> do
-            zipWithM_ dPrimV_ is $ unflattenIndex dims' $ sExt64 group_id
+            dIndexSpace (zip is dims') $ sExt64 group_id
 
             compileStms mempty (kernelBodyStms kbody) $
               zipWithM_ (compileGroupResult space) (patternElements pat) $
                 kernelBodyResult kbody
+  emit $ Imp.DebugPrint "" Nothing
diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs
--- a/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs
+++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs
@@ -209,12 +209,8 @@
             `divUp` Imp.elements (sExt64 (kernelNumThreads constants))
 
     slugs <-
-      mapM
-        ( segBinOpSlug
-            (kernelLocalThreadId constants)
-            (kernelGroupId constants)
-        )
-        $ zip3 reds reds_arrs reds_group_res_arrs
+      mapM (segBinOpSlug (kernelLocalThreadId constants) (kernelGroupId constants)) $
+        zip3 reds reds_arrs reds_group_res_arrs
     reds_op_renamed <-
       reductionStageOne
         constants
@@ -229,45 +225,31 @@
     let segred_pes =
           chunks (map (length . segBinOpNeutral) reds) $
             patternElements segred_pat
-    forM_
-      ( zip7
-          reds
-          reds_arrs
-          reds_group_res_arrs
-          segred_pes
-          slugs
-          reds_op_renamed
-          [0 ..]
-      )
-      $ \( SegBinOp _ red_op nes _,
-           red_arrs,
-           group_res_arrs,
-           pes,
-           slug,
-           red_op_renamed,
-           i
-           ) -> do
-          let (red_x_params, red_y_params) = splitAt (length nes) $ lambdaParams red_op
-          reductionStageTwo
-            constants
-            pes
-            (kernelGroupId constants)
-            0
-            [0]
-            0
-            (sExt64 $ kernelNumGroups constants)
-            slug
-            red_x_params
-            red_y_params
-            red_op_renamed
-            nes
-            1
-            counter
-            (fromInteger i)
-            sync_arr
-            group_res_arrs
-            red_arrs
+    forM_ (zip7 reds reds_arrs reds_group_res_arrs segred_pes slugs reds_op_renamed [0 ..]) $
+      \(SegBinOp _ red_op nes _, red_arrs, group_res_arrs, pes, slug, red_op_renamed, i) -> do
+        let (red_x_params, red_y_params) = splitAt (length nes) $ lambdaParams red_op
+        reductionStageTwo
+          constants
+          pes
+          (kernelGroupId constants)
+          0
+          [0]
+          0
+          (sExt64 $ kernelNumGroups constants)
+          slug
+          red_x_params
+          red_y_params
+          red_op_renamed
+          nes
+          1
+          counter
+          (fromInteger i)
+          sync_arr
+          group_res_arrs
+          red_arrs
 
+  emit $ Imp.DebugPrint "" Nothing
+
 smallSegmentsReduction ::
   Pattern KernelsMem ->
   Count NumGroups SubExp ->
@@ -315,7 +297,7 @@
               + (sExt64 group_id' * sExt64 segments_per_group)
           index_within_segment = ltid `rem` segment_size
 
-      zipWithM_ dPrimV_ (init gtids) $ unflattenIndex (init dims') segment_index
+      dIndexSpace (zip (init gtids) (init dims')) segment_index
       dPrimV_ (last gtids) index_within_segment
 
       let out_of_bounds =
@@ -375,6 +357,8 @@
       -- local memory array first thing in the next iteration.
       sOp $ Imp.Barrier Imp.FenceLocal
 
+  emit $ Imp.DebugPrint "" Nothing
+
 largeSegmentsReduction ::
   Pattern KernelsMem ->
   Count NumGroups SubExp ->
@@ -458,9 +442,7 @@
             `rem` (sExt64 (unCount group_size') * groups_per_segment)
 
       let first_group_for_segment = sExt64 flat_segment_id * groups_per_segment
-
-      zipWithM_ dPrimV_ segment_gtids $
-        unflattenIndex (init dims') $ sExt64 flat_segment_id
+      dIndexSpace (zip segment_gtids (init dims')) $sExt64 flat_segment_id
       dPrim_ (last gtids) int64
       let num_elements = Imp.elements $ toInt64Exp w
 
@@ -483,45 +465,29 @@
               patternElements segred_pat
 
           multiple_groups_per_segment =
-            forM_
-              ( zip7
-                  reds
-                  reds_arrs
-                  reds_group_res_arrs
-                  segred_pes
-                  slugs
-                  reds_op_renamed
-                  [0 ..]
-              )
-              $ \( SegBinOp _ red_op nes _,
-                   red_arrs,
-                   group_res_arrs,
-                   pes,
-                   slug,
-                   red_op_renamed,
-                   i
-                   ) -> do
-                  let (red_x_params, red_y_params) =
-                        splitAt (length nes) $ lambdaParams red_op
-                  reductionStageTwo
-                    constants
-                    pes
-                    group_id
-                    flat_segment_id
-                    (map Imp.vi64 segment_gtids)
-                    (sExt64 first_group_for_segment)
-                    groups_per_segment
-                    slug
-                    red_x_params
-                    red_y_params
-                    red_op_renamed
-                    nes
-                    (fromIntegral num_counters)
-                    counter
-                    (fromInteger i)
-                    sync_arr
-                    group_res_arrs
-                    red_arrs
+            forM_ (zip7 reds reds_arrs reds_group_res_arrs segred_pes slugs reds_op_renamed [0 ..]) $
+              \(SegBinOp _ red_op nes _, red_arrs, group_res_arrs, pes, slug, red_op_renamed, i) -> do
+                let (red_x_params, red_y_params) =
+                      splitAt (length nes) $ lambdaParams red_op
+                reductionStageTwo
+                  constants
+                  pes
+                  group_id
+                  flat_segment_id
+                  (map Imp.vi64 segment_gtids)
+                  (sExt64 first_group_for_segment)
+                  groups_per_segment
+                  slug
+                  red_x_params
+                  red_y_params
+                  red_op_renamed
+                  nes
+                  (fromIntegral num_counters)
+                  counter
+                  (fromInteger i)
+                  sync_arr
+                  group_res_arrs
+                  red_arrs
 
           one_group_per_segment =
             comment "first thread in group saves final result to memory" $
@@ -531,6 +497,8 @@
                     copyDWIMFix (patElemName v) (map Imp.vi64 segment_gtids) (Var acc) acc_is
 
       sIf (groups_per_segment .==. 1) one_group_per_segment multiple_groups_per_segment
+
+  emit $ Imp.DebugPrint "" Nothing
 
 -- Careful to avoid division by zero here.  We have at least one group
 -- per segment.
diff --git a/src/Futhark/CodeGen/ImpGen/Multicore/SegMap.hs b/src/Futhark/CodeGen/ImpGen/Multicore/SegMap.hs
--- a/src/Futhark/CodeGen/ImpGen/Multicore/SegMap.hs
+++ b/src/Futhark/CodeGen/ImpGen/Multicore/SegMap.hs
@@ -45,7 +45,7 @@
   kstms' <- mapM renameStm kstms
   collect $ do
     emit $ Imp.DebugPrint "SegMap fbody" Nothing
-    zipWithM_ dPrimV_ is $ map sExt64 $ unflattenIndex ns' $ tvExp flat_idx
+    dIndexSpace (zip is ns') $ tvExp flat_idx
     compileStms (freeIn kres) kstms' $
       zipWithM_ (writeResult is) (patternElements pat) kres
 
diff --git a/src/Futhark/CodeGen/ImpGen/Transpose.hs b/src/Futhark/CodeGen/ImpGen/Transpose.hs
--- a/src/Futhark/CodeGen/ImpGen/Transpose.hs
+++ b/src/Futhark/CodeGen/ImpGen/Transpose.hs
@@ -42,7 +42,7 @@
 mapTransposeFunction :: Name -> PrimType -> Function op
 mapTransposeFunction fname pt =
   Function
-    False
+    Nothing
     []
     params
     ( mconcat
diff --git a/src/Futhark/Compiler.hs b/src/Futhark/Compiler.hs
--- a/src/Futhark/Compiler.hs
+++ b/src/Futhark/Compiler.hs
@@ -6,11 +6,10 @@
 module Futhark.Compiler
   ( runPipelineOnProgram,
     runCompilerOnProgram,
-    FutharkConfig (..),
-    newFutharkConfig,
     dumpError,
     handleWarnings,
     module Futhark.Compiler.Program,
+    module Futhark.Compiler.Config,
     readProgram,
     readProgramOrDie,
     readUntypedProgram,
@@ -23,6 +22,7 @@
 import Data.Bifunctor (first)
 import qualified Data.Text.IO as T
 import qualified Futhark.Analysis.Alias as Alias
+import Futhark.Compiler.Config
 import Futhark.Compiler.Program
 import Futhark.IR
 import qualified Futhark.IR.SOACS as I
@@ -38,36 +38,6 @@
 import System.Exit (ExitCode (..), exitWith)
 import System.IO
 
--- | The compiler configuration.  This only contains options related
--- to core compiler functionality, such as reading the initial program
--- and running passes.  Options related to code generation are handled
--- elsewhere.
-data FutharkConfig = FutharkConfig
-  { futharkVerbose :: (Verbosity, Maybe FilePath),
-    -- | Warn if True.
-    futharkWarn :: Bool,
-    -- | If true, error on any warnings.
-    futharkWerror :: Bool,
-    -- | If True, ignore @unsafe@.
-    futharkSafe :: Bool,
-    -- | Additional functions that should be exposed as entry points.
-    futharkEntryPoints :: [Name],
-    -- | If false, disable type-checking
-    futharkTypeCheck :: Bool
-  }
-
--- | The default compiler configuration.
-newFutharkConfig :: FutharkConfig
-newFutharkConfig =
-  FutharkConfig
-    { futharkVerbose = (NotVerbose, Nothing),
-      futharkWarn = True,
-      futharkWerror = False,
-      futharkSafe = False,
-      futharkEntryPoints = [],
-      futharkTypeCheck = True
-    }
-
 -- | Print a compiler error to stdout.  The 'FutharkConfig' controls
 -- to which degree auxiliary information (e.g. the failing program) is
 -- also printed.
@@ -137,9 +107,7 @@
         <$> readProgram (futharkEntryPoints config) file
 
   putNameSource namesrc
-  when (pipelineVerbose pipeline_config) $
-    logMsg ("Internalising program" :: String)
-  int_prog <- internaliseProg (futharkSafe config) prog_imports
+  int_prog <- internaliseProg config prog_imports
   when (pipelineVerbose pipeline_config) $
     logMsg ("Type-checking internalised program" :: String)
   typeCheckInternalProgram int_prog
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
@@ -19,7 +19,6 @@
 import Futhark.Pipeline
 import Futhark.Util.Options
 import System.FilePath
-import System.IO
 
 -- | Run a parameterised Futhark compiler, where @cfg@ is a user-given
 -- configuration type.  Call this from @main@.
@@ -47,16 +46,12 @@
   -- | Command line arguments.
   [String] ->
   IO ()
-compilerMain cfg cfg_opts name desc pipeline doIt prog args = do
-  hSetEncoding stdout utf8
-  hSetEncoding stderr utf8
+compilerMain cfg cfg_opts name desc pipeline doIt =
   mainWithOptions
     (newCompilerConfig cfg)
     (commandLineOptions ++ map wrapOption cfg_opts)
     "options... <program.fut>"
     inspectNonOptions
-    prog
-    args
   where
     inspectNonOptions [file] config = Just $ compile config file
     inspectNonOptions _ _ = Nothing
@@ -137,7 +132,7 @@
       "Ignore 'unsafe' in code.",
     Option
       []
-      ["entry-points"]
+      ["entry-point"]
       ( ReqArg
           ( \arg -> Right $ \config ->
               config
diff --git a/src/Futhark/Compiler/Config.hs b/src/Futhark/Compiler/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Futhark/Compiler/Config.hs
@@ -0,0 +1,39 @@
+module Futhark.Compiler.Config
+  ( FutharkConfig (..),
+    newFutharkConfig,
+    Verbosity (..),
+  )
+where
+
+import Futhark.IR
+import Futhark.Pipeline
+
+-- | The compiler configuration.  This only contains options related
+-- to core compiler functionality, such as reading the initial program
+-- and running passes.  Options related to code generation are handled
+-- elsewhere.
+data FutharkConfig = FutharkConfig
+  { futharkVerbose :: (Verbosity, Maybe FilePath),
+    -- | Warn if True.
+    futharkWarn :: Bool,
+    -- | If true, error on any warnings.
+    futharkWerror :: Bool,
+    -- | If True, ignore @unsafe@.
+    futharkSafe :: Bool,
+    -- | Additional functions that should be exposed as entry points.
+    futharkEntryPoints :: [Name],
+    -- | If false, disable type-checking
+    futharkTypeCheck :: Bool
+  }
+
+-- | The default compiler configuration.
+newFutharkConfig :: FutharkConfig
+newFutharkConfig =
+  FutharkConfig
+    { futharkVerbose = (NotVerbose, Nothing),
+      futharkWarn = True,
+      futharkWerror = False,
+      futharkSafe = False,
+      futharkEntryPoints = [],
+      futharkTypeCheck = True
+    }
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
@@ -31,6 +31,7 @@
 import Language.Futhark.Semantic
 import qualified Language.Futhark.TypeChecker as E
 import Language.Futhark.Warnings
+import System.FilePath (normalise)
 import qualified System.FilePath.Posix as Posix
 
 newtype ReaderState = ReaderState
@@ -161,8 +162,9 @@
   [(ImportName, E.UncheckedProg)]
 setEntryPoints extra_eps fps = map onProg
   where
+    fps' = map normalise fps
     onProg (name, prog)
-      | includeToFilePath name `elem` fps =
+      | includeToFilePath name `elem` fps' =
         (name, prog {E.progDecs = map onDec (E.progDecs prog)})
       | otherwise =
         (name, prog)
diff --git a/src/Futhark/IR/Parse.hs b/src/Futhark/IR/Parse.hs
--- a/src/Futhark/IR/Parse.hs
+++ b/src/Futhark/IR/Parse.hs
@@ -510,7 +510,11 @@
     pResult = braces $ pSubExp `sepBy` pComma
 
 pEntry :: Parser EntryPoint
-pEntry = parens $ (,) <$> pEntryPointTypes <* pComma <*> pEntryPointTypes
+pEntry =
+  parens $
+    (,,) <$> (nameFromString <$> pStringLiteral)
+      <* pComma <*> pEntryPointTypes
+      <* pComma <*> pEntryPointTypes
   where
     pEntryPointTypes = braces (pEntryPointType `sepBy` pComma)
     pEntryPointType =
diff --git a/src/Futhark/IR/Pretty.hs b/src/Futhark/IR/Pretty.hs
--- a/src/Futhark/IR/Pretty.hs
+++ b/src/Futhark/IR/Pretty.hs
@@ -287,7 +287,7 @@
 instance PrettyLore lore => Pretty (Lambda lore) where
   ppr (Lambda [] (Body _ stms []) []) | stms == mempty = text "nilFn"
   ppr (Lambda params body rettype) =
-    text "\\" <> ppTuple' params
+    text "\\" <+> ppTuple' params
       <+/> colon <+> ppTuple' rettype <+> text "->"
       </> indent 2 (ppr body)
 
@@ -307,9 +307,13 @@
     where
       fun = case entry of
         Nothing -> "fun"
-        Just (p_entry, ret_entry) ->
+        Just (p_name, p_entry, ret_entry) ->
           "entry"
-            <> nestedBlock "(" ")" (ppTuple' p_entry <> comma </> ppTuple' ret_entry)
+            <> parens
+              ( "\"" <> ppr p_name <> "\"" <> comma
+                  </> ppTuple' p_entry <> comma
+                  </> ppTuple' ret_entry
+              )
 
 instance PrettyLore lore => Pretty (Prog lore) where
   ppr (Prog consts funs) =
diff --git a/src/Futhark/IR/Primitive.hs b/src/Futhark/IR/Primitive.hs
--- a/src/Futhark/IR/Primitive.hs
+++ b/src/Futhark/IR/Primitive.hs
@@ -121,6 +121,8 @@
     ceilFloat,
     floorDouble,
     floorFloat,
+    hypot,
+    hypotf,
     lgamma,
     lgammaf,
     roundDouble,
@@ -626,7 +628,8 @@
 
 -- | @abs(-2.0) = 2.0@.
 doFAbs :: FloatValue -> FloatValue
-doFAbs v = floatValue (floatValueType v) $ abs $ floatToDouble v
+doFAbs (Float32Value x) = Float32Value $ abs x
+doFAbs (Float64Value x) = Float64Value $ abs x
 
 -- | @ssignum(-2)@ = -1.
 doSSignum :: IntValue -> IntValue
@@ -1229,7 +1232,7 @@
           FloatType Float32,
           \case
             [FloatValue (Float32Value x), FloatValue (Float32Value y)] ->
-              Just $ FloatValue $ Float32Value $ sqrt (x * x + y * y)
+              Just $ FloatValue $ Float32Value $ hypotf x y
             _ -> Nothing
         )
       ),
@@ -1238,7 +1241,7 @@
           FloatType Float64,
           \case
             [FloatValue (Float64Value x), FloatValue (Float64Value y)] ->
-              Just $ FloatValue $ Float64Value $ sqrt (x * x + y * y)
+              Just $ FloatValue $ Float64Value $ hypot x y
             _ -> Nothing
         )
       ),
diff --git a/src/Futhark/IR/Syntax.hs b/src/Futhark/IR/Syntax.hs
--- a/src/Futhark/IR/Syntax.hs
+++ b/src/Futhark/IR/Syntax.hs
@@ -514,7 +514,7 @@
 -- | Information about the parameters and return value of an entry
 -- point.  The first element is for parameters, the second for return
 -- value.
-type EntryPoint = ([EntryPointType], [EntryPointType])
+type EntryPoint = (Name, [EntryPointType], [EntryPointType])
 
 -- | Every entry point argument and return value has an annotation
 -- indicating how it maps to the original source program type.
diff --git a/src/Futhark/Internalise.hs b/src/Futhark/Internalise.hs
--- a/src/Futhark/Internalise.hs
+++ b/src/Futhark/Internalise.hs
@@ -1,2133 +1,44 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE Strict #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- |
---
--- This module implements a transformation from source to core
--- Futhark.
-module Futhark.Internalise (internaliseProg) where
-
-import Control.Monad.Reader
-import Data.List (find, intercalate, intersperse, transpose)
-import qualified Data.List.NonEmpty as NE
-import qualified Data.Map.Strict as M
-import qualified Data.Set as S
-import Futhark.IR.SOACS as I hiding (stmPattern)
-import Futhark.Internalise.AccurateSizes
-import Futhark.Internalise.Bindings
-import Futhark.Internalise.Defunctionalise as Defunctionalise
-import Futhark.Internalise.Defunctorise as Defunctorise
-import Futhark.Internalise.Lambdas
-import Futhark.Internalise.LiftLambdas as LiftLambdas
-import Futhark.Internalise.Monad as I
-import Futhark.Internalise.Monomorphise as Monomorphise
-import Futhark.Internalise.TypesValues
-import Futhark.Transform.Rename as I
-import Futhark.Util (splitAt3)
-import Futhark.Util.Pretty (prettyOneLine)
-import Language.Futhark as E hiding (TypeArg)
-import Language.Futhark.Semantic (Imports)
-
--- | Convert a program in source Futhark to a program in the Futhark
--- core language.
-internaliseProg ::
-  MonadFreshNames m =>
-  Bool ->
-  Imports ->
-  m (I.Prog SOACS)
-internaliseProg always_safe prog = do
-  prog_decs <- Defunctorise.transformProg prog
-  prog_decs' <- Monomorphise.transformProg prog_decs
-  prog_decs'' <- LiftLambdas.transformProg prog_decs'
-  prog_decs''' <- Defunctionalise.transformProg prog_decs''
-  (consts, funs) <-
-    runInternaliseM always_safe (internaliseValBinds prog_decs''')
-  I.renameProg $ I.Prog consts funs
-
-internaliseAttr :: E.AttrInfo -> Attr
-internaliseAttr (E.AttrAtom v) = I.AttrAtom v
-internaliseAttr (E.AttrComp f attrs) = I.AttrComp f $ map internaliseAttr attrs
-
-internaliseAttrs :: [E.AttrInfo] -> Attrs
-internaliseAttrs = mconcat . map (oneAttr . internaliseAttr)
-
-internaliseValBinds :: [E.ValBind] -> InternaliseM ()
-internaliseValBinds = mapM_ internaliseValBind
-
-internaliseFunName :: VName -> Name
-internaliseFunName = nameFromString . pretty
-
-internaliseValBind :: E.ValBind -> InternaliseM ()
-internaliseValBind fb@(E.ValBind entry fname retdecl (Info (rettype, _)) tparams params body _ attrs loc) = do
-  localConstsScope $
-    bindingFParams tparams params $ \shapeparams params' -> do
-      let shapenames = map I.paramName shapeparams
-
-      msg <- case retdecl of
-        Just dt ->
-          errorMsg
-            . ("Function return value does not match shape of type " :)
-            <$> typeExpForError dt
-        Nothing -> return $ errorMsg ["Function return value does not match shape of declared return type."]
-
-      (body', rettype') <- buildBody $ do
-        body_res <- internaliseExp (baseString fname <> "_res") body
-        rettype_bad <-
-          internaliseReturnType rettype =<< mapM subExpType body_res
-        let rettype' = zeroExts rettype_bad
-        body_res' <-
-          ensureResultExtShape msg loc (map I.fromDecl rettype') body_res
-        pure (body_res', rettype')
-
-      let all_params = shapeparams ++ concat params'
-
-      let fd =
-            I.FunDef
-              Nothing
-              (internaliseAttrs attrs)
-              (internaliseFunName fname)
-              rettype'
-              all_params
-              body'
-
-      if null params'
-        then bindConstant fname fd
-        else
-          bindFunction
-            fname
-            fd
-            ( shapenames,
-              map declTypeOf $ concat params',
-              all_params,
-              applyRetType rettype' all_params
-            )
-
-  case entry of
-    Just (Info entry') -> generateEntryPoint entry' fb
-    Nothing -> return ()
-  where
-    zeroExts ts = generaliseExtTypes ts ts
-
-generateEntryPoint :: E.EntryPoint -> E.ValBind -> InternaliseM ()
-generateEntryPoint (E.EntryPoint e_paramts e_rettype) vb = localConstsScope $ do
-  let (E.ValBind _ ofname _ (Info (rettype, _)) tparams params _ _ attrs loc) = vb
-  bindingFParams tparams params $ \shapeparams params' -> do
-    entry_rettype <- internaliseEntryReturnType rettype
-    let entry' = entryPoint (zip e_paramts params') (e_rettype, entry_rettype)
-        args = map (I.Var . I.paramName) $ concat params'
-
-    entry_body <- buildBody_ $ do
-      -- Special case the (rare) situation where the entry point is
-      -- not a function.
-      maybe_const <- lookupConst ofname
-      vals <- case maybe_const of
-        Just ses ->
-          return ses
-        Nothing ->
-          fst <$> funcall "entry_result" (E.qualName ofname) args loc
-      ctx <-
-        extractShapeContext (concat entry_rettype)
-          <$> mapM (fmap I.arrayDims . subExpType) vals
-      pure $ ctx ++ vals
-
-    addFunDef $
-      I.FunDef
-        (Just entry')
-        (internaliseAttrs attrs)
-        (baseName ofname)
-        (concat entry_rettype)
-        (shapeparams ++ concat params')
-        entry_body
-
-entryPoint ::
-  [(E.EntryType, [I.FParam])] ->
-  ( E.EntryType,
-    [[I.TypeBase ExtShape Uniqueness]]
-  ) ->
-  I.EntryPoint
-entryPoint params (eret, crets) =
-  ( concatMap (entryPointType . preParam) params,
-    case ( isTupleRecord $ entryType eret,
-           entryAscribed eret
-         ) of
-      (Just ts, Just (E.TETuple e_ts _)) ->
-        concatMap entryPointType $
-          zip (zipWith E.EntryType ts (map Just e_ts)) crets
-      (Just ts, Nothing) ->
-        concatMap entryPointType $
-          zip (map (`E.EntryType` Nothing) ts) crets
-      _ ->
-        entryPointType (eret, concat crets)
-  )
-  where
-    preParam (e_t, ps) = (e_t, staticShapes $ map I.paramDeclType ps)
-
-    entryPointType (t, ts)
-      | E.Scalar (E.Prim E.Unsigned {}) <- E.entryType t =
-        [I.TypeUnsigned]
-      | E.Array _ _ (E.Prim E.Unsigned {}) _ <- E.entryType t =
-        [I.TypeUnsigned]
-      | E.Scalar E.Prim {} <- E.entryType t =
-        [I.TypeDirect]
-      | E.Array _ _ E.Prim {} _ <- E.entryType t =
-        [I.TypeDirect]
-      | otherwise =
-        [I.TypeOpaque desc $ length ts]
-      where
-        desc = maybe (prettyOneLine t') typeExpOpaqueName $ E.entryAscribed t
-        t' = noSizes (E.entryType t) `E.setUniqueness` Nonunique
-    typeExpOpaqueName (TEApply te TypeArgExpDim {} _) =
-      typeExpOpaqueName te
-    typeExpOpaqueName (TEArray te _ _) =
-      let (d, te') = withoutDims te
-       in "arr_" ++ typeExpOpaqueName te'
-            ++ "_"
-            ++ show (1 + d)
-            ++ "d"
-    typeExpOpaqueName te = prettyOneLine te
-
-    withoutDims (TEArray te _ _) =
-      let (d, te') = withoutDims te
-       in (d + 1, te')
-    withoutDims te = (0 :: Int, te)
-
-internaliseBody :: String -> E.Exp -> InternaliseM Body
-internaliseBody desc e =
-  buildBody_ $ internaliseExp (desc <> "_res") e
-
-bodyFromStms ::
-  InternaliseM (Result, a) ->
-  InternaliseM (Body, a)
-bodyFromStms m = do
-  ((res, a), stms) <- collectStms m
-  (,a) <$> mkBodyM stms res
-
-internaliseAppExp :: String -> E.AppExp -> InternaliseM [I.SubExp]
-internaliseAppExp desc (E.Index e idxs loc) = do
-  vs <- internaliseExpToVars "indexed" e
-  dims <- case vs of
-    [] -> return [] -- Will this happen?
-    v : _ -> I.arrayDims <$> lookupType v
-  (idxs', cs) <- internaliseSlice loc dims idxs
-  let index v = do
-        v_t <- lookupType v
-        return $ I.BasicOp $ I.Index v $ fullSlice v_t idxs'
-  certifying cs $ letSubExps desc =<< mapM index vs
-internaliseAppExp desc (E.Range start maybe_second end loc) = do
-  start' <- internaliseExp1 "range_start" start
-  end' <- internaliseExp1 "range_end" $ case end of
-    DownToExclusive e -> e
-    ToInclusive e -> e
-    UpToExclusive e -> e
-  maybe_second' <-
-    traverse (internaliseExp1 "range_second") maybe_second
-
-  -- Construct an error message in case the range is invalid.
-  let conv = case E.typeOf start of
-        E.Scalar (E.Prim (E.Unsigned _)) -> asIntZ Int64
-        _ -> asIntS Int64
-  start'_i64 <- conv start'
-  end'_i64 <- conv end'
-  maybe_second'_i64 <- traverse conv maybe_second'
-  let errmsg =
-        errorMsg $
-          ["Range "]
-            ++ [ErrorInt64 start'_i64]
-            ++ ( case maybe_second'_i64 of
-                   Nothing -> []
-                   Just second_i64 -> ["..", ErrorInt64 second_i64]
-               )
-            ++ ( case end of
-                   DownToExclusive {} -> ["..>"]
-                   ToInclusive {} -> ["..."]
-                   UpToExclusive {} -> ["..<"]
-               )
-            ++ [ErrorInt64 end'_i64, " is invalid."]
-
-  (it, le_op, lt_op) <-
-    case E.typeOf start of
-      E.Scalar (E.Prim (E.Signed it)) -> return (it, CmpSle it, CmpSlt it)
-      E.Scalar (E.Prim (E.Unsigned it)) -> return (it, CmpUle it, CmpUlt it)
-      start_t -> error $ "Start value in range has type " ++ pretty start_t
-
-  let one = intConst it 1
-      negone = intConst it (-1)
-      default_step = case end of
-        DownToExclusive {} -> negone
-        ToInclusive {} -> one
-        UpToExclusive {} -> one
-
-  (step, step_zero) <- case maybe_second' of
-    Just second' -> do
-      subtracted_step <-
-        letSubExp "subtracted_step" $
-          I.BasicOp $ I.BinOp (I.Sub it I.OverflowWrap) second' start'
-      step_zero <- letSubExp "step_zero" $ I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) start' second'
-      return (subtracted_step, step_zero)
-    Nothing ->
-      return (default_step, constant False)
-
-  step_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum it) step
-  step_sign_i64 <- asIntS Int64 step_sign
-
-  bounds_invalid_downwards <-
-    letSubExp "bounds_invalid_downwards" $
-      I.BasicOp $ I.CmpOp le_op start' end'
-  bounds_invalid_upwards <-
-    letSubExp "bounds_invalid_upwards" $
-      I.BasicOp $ I.CmpOp lt_op end' start'
-
-  (distance, step_wrong_dir, bounds_invalid) <- case end of
-    DownToExclusive {} -> do
-      step_wrong_dir <-
-        letSubExp "step_wrong_dir" $
-          I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign one
-      distance <-
-        letSubExp "distance" $
-          I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) start' end'
-      distance_i64 <- asIntS Int64 distance
-      return (distance_i64, step_wrong_dir, bounds_invalid_downwards)
-    UpToExclusive {} -> do
-      step_wrong_dir <-
-        letSubExp "step_wrong_dir" $
-          I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign negone
-      distance <- letSubExp "distance" $ I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) end' start'
-      distance_i64 <- asIntS Int64 distance
-      return (distance_i64, step_wrong_dir, bounds_invalid_upwards)
-    ToInclusive {} -> do
-      downwards <-
-        letSubExp "downwards" $
-          I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign negone
-      distance_downwards_exclusive <-
-        letSubExp "distance_downwards_exclusive" $
-          I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) start' end'
-      distance_upwards_exclusive <-
-        letSubExp "distance_upwards_exclusive" $
-          I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) end' start'
-
-      bounds_invalid <-
-        letSubExp "bounds_invalid" $
-          I.If
-            downwards
-            (resultBody [bounds_invalid_downwards])
-            (resultBody [bounds_invalid_upwards])
-            $ ifCommon [I.Prim I.Bool]
-      distance_exclusive <-
-        letSubExp "distance_exclusive" $
-          I.If
-            downwards
-            (resultBody [distance_downwards_exclusive])
-            (resultBody [distance_upwards_exclusive])
-            $ ifCommon [I.Prim $ IntType it]
-      distance_exclusive_i64 <- asIntS Int64 distance_exclusive
-      distance <-
-        letSubExp "distance" $
-          I.BasicOp $
-            I.BinOp
-              (Add Int64 I.OverflowWrap)
-              distance_exclusive_i64
-              (intConst Int64 1)
-      return (distance, constant False, bounds_invalid)
-
-  step_invalid <-
-    letSubExp "step_invalid" $
-      I.BasicOp $ I.BinOp I.LogOr step_wrong_dir step_zero
-
-  invalid <-
-    letSubExp "range_invalid" $
-      I.BasicOp $ I.BinOp I.LogOr step_invalid bounds_invalid
-  valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp I.Not invalid
-  cs <- assert "range_valid_c" valid errmsg loc
-
-  step_i64 <- asIntS Int64 step
-  pos_step <-
-    letSubExp "pos_step" $
-      I.BasicOp $ I.BinOp (Mul Int64 I.OverflowWrap) step_i64 step_sign_i64
-
-  num_elems <-
-    certifying cs $
-      letSubExp "num_elems" $
-        I.BasicOp $ I.BinOp (SDivUp Int64 I.Unsafe) distance pos_step
-
-  se <- letSubExp desc (I.BasicOp $ I.Iota num_elems start' step it)
-  return [se]
-internaliseAppExp desc (E.Coerce e (TypeDecl dt (Info et)) loc) = do
-  ses <- internaliseExp desc e
-  ts <- internaliseReturnType et =<< mapM subExpType ses
-  dt' <- typeExpForError dt
-  forM (zip ses ts) $ \(e', t') -> do
-    dims <- arrayDims <$> subExpType e'
-    let parts =
-          ["Value of (core language) shape ("]
-            ++ intersperse ", " (map ErrorInt64 dims)
-            ++ [") cannot match shape of type `"]
-            ++ dt'
-            ++ ["`."]
-    ensureExtShape (errorMsg parts) loc (I.fromDecl t') desc e'
-internaliseAppExp desc e@E.Apply {} = do
-  (qfname, args) <- findFuncall e
-
-  -- Argument evaluation is outermost-in so that any existential sizes
-  -- created by function applications can be brought into scope.
-  let fname = nameFromString $ pretty $ baseName $ qualLeaf qfname
-      loc = srclocOf e
-      arg_desc = nameToString fname ++ "_arg"
-
-  -- Some functions are magical (overloaded) and we handle that here.
-  case () of
-    -- Overloaded functions never take array arguments (except
-    -- equality, but those cannot be existential), so we can safely
-    -- ignore the existential dimensions.
-    ()
-      | Just internalise <- isOverloadedFunction qfname (map fst args) loc ->
-        internalise desc
-      | baseTag (qualLeaf qfname) <= maxIntrinsicTag,
-        Just (rettype, _) <- M.lookup fname I.builtInFunctions -> do
-        let tag ses = [(se, I.Observe) | se <- ses]
-        args' <- reverse <$> mapM (internaliseArg arg_desc) (reverse args)
-        let args'' = concatMap tag args'
-        letTupExp' desc $
-          I.Apply
-            fname
-            args''
-            [I.Prim rettype]
-            (Safe, loc, [])
-      | otherwise -> do
-        args' <- concat . reverse <$> mapM (internaliseArg arg_desc) (reverse args)
-        fst <$> funcall desc qfname args' loc
-internaliseAppExp desc (E.LetPat sizes pat e body _) =
-  internalisePat desc sizes pat e body (internaliseExp desc)
-internaliseAppExp _ (E.LetFun ofname _ _ _) =
-  error $ "Unexpected LetFun " ++ pretty ofname
-internaliseAppExp desc (E.DoLoop sparams mergepat mergeexp form loopbody loc) = do
-  ses <- internaliseExp "loop_init" mergeexp
-  ((loopbody', (form', shapepat, mergepat', mergeinit')), initstms) <-
-    collectStms $ handleForm ses form
-
-  addStms initstms
-  mergeinit_ts' <- mapM subExpType mergeinit'
-
-  ctxinit <- argShapes (map I.paramName shapepat) mergepat' mergeinit_ts'
-
-  let ctxmerge = zip shapepat ctxinit
-      valmerge = zip mergepat' mergeinit'
-      dropCond = case form of
-        E.While {} -> drop 1
-        _ -> id
-
-  -- Ensure that the result of the loop matches the shapes of the
-  -- merge parameters.  XXX: Ideally they should already match (by
-  -- the source language type rules), but some of our
-  -- transformations (esp. defunctionalisation) strips out some size
-  -- information.  For a type-correct source program, these reshapes
-  -- should simplify away.
-  let merge = ctxmerge ++ valmerge
-      merge_ts = map (I.paramType . fst) merge
-  loopbody'' <-
-    localScope (scopeOfFParams $ map fst merge) . inScopeOf form' . buildBody_ $
-      ensureArgShapes
-        "shape of loop result does not match shapes in loop parameter"
-        loc
-        (map (I.paramName . fst) ctxmerge)
-        merge_ts
-        =<< bodyBind loopbody'
-
-  attrs <- asks envAttrs
-  map I.Var . dropCond
-    <$> attributing
-      attrs
-      (letTupExp desc (I.DoLoop ctxmerge valmerge form' loopbody''))
-  where
-    sparams' = map (`TypeParamDim` mempty) sparams
-
-    forLoop mergepat' shapepat mergeinit form' =
-      bodyFromStms $
-        inScopeOf form' $ do
-          ses <- internaliseExp "loopres" loopbody
-          sets <- mapM subExpType ses
-          shapeargs <- argShapes (map I.paramName shapepat) mergepat' sets
-          return
-            ( shapeargs ++ ses,
-              ( form',
-                shapepat,
-                mergepat',
-                mergeinit
-              )
-            )
-
-    handleForm mergeinit (E.ForIn x arr) = do
-      arr' <- internaliseExpToVars "for_in_arr" arr
-      arr_ts <- mapM lookupType arr'
-      let w = arraysSize 0 arr_ts
-
-      i <- newVName "i"
-
-      ts <- mapM subExpType mergeinit
-      bindingLoopParams sparams' mergepat ts $
-        \shapepat mergepat' ->
-          bindingLambdaParams [x] (map rowType arr_ts) $ \x_params -> do
-            let loopvars = zip x_params arr'
-            forLoop mergepat' shapepat mergeinit $
-              I.ForLoop i Int64 w loopvars
-    handleForm mergeinit (E.For i num_iterations) = do
-      num_iterations' <- internaliseExp1 "upper_bound" num_iterations
-      num_iterations_t <- I.subExpType num_iterations'
-      it <- case num_iterations_t of
-        I.Prim (IntType it) -> return it
-        _ -> error "internaliseExp DoLoop: invalid type"
-
-      ts <- mapM subExpType mergeinit
-      bindingLoopParams sparams' mergepat ts $
-        \shapepat mergepat' ->
-          forLoop mergepat' shapepat mergeinit $
-            I.ForLoop (E.identName i) it num_iterations' []
-    handleForm mergeinit (E.While cond) = do
-      ts <- mapM subExpType mergeinit
-      bindingLoopParams sparams' mergepat ts $ \shapepat mergepat' -> do
-        mergeinit_ts <- mapM subExpType mergeinit
-        -- We need to insert 'cond' twice - once for the initial
-        -- condition (do we enter the loop at all?), and once with the
-        -- result values of the loop (do we continue into the next
-        -- iteration?).  This is safe, as the type rules for the
-        -- external language guarantees that 'cond' does not consume
-        -- anything.
-        shapeinit <- argShapes (map I.paramName shapepat) mergepat' mergeinit_ts
-
-        (loop_initial_cond, init_loop_cond_bnds) <- collectStms $ do
-          forM_ (zip shapepat shapeinit) $ \(p, se) ->
-            letBindNames [paramName p] $ BasicOp $ SubExp se
-          forM_ (zip mergepat' mergeinit) $ \(p, se) ->
-            unless (se == I.Var (paramName p)) $
-              letBindNames [paramName p] $
-                BasicOp $
-                  case se of
-                    I.Var v
-                      | not $ primType $ paramType p ->
-                        Reshape (map DimCoercion $ arrayDims $ paramType p) v
-                    _ -> SubExp se
-          internaliseExp1 "loop_cond" cond
-
-        addStms init_loop_cond_bnds
-
-        bodyFromStms $ do
-          ses <- internaliseExp "loopres" loopbody
-          sets <- mapM subExpType ses
-          loop_while <- newParam "loop_while" $ I.Prim I.Bool
-          shapeargs <- argShapes (map I.paramName shapepat) mergepat' sets
-
-          -- Careful not to clobber anything.
-          loop_end_cond_body <- renameBody <=< buildBody_ $ do
-            forM_ (zip shapepat shapeargs) $ \(p, se) ->
-              unless (se == I.Var (paramName p)) $
-                letBindNames [paramName p] $ BasicOp $ SubExp se
-            forM_ (zip mergepat' ses) $ \(p, se) ->
-              unless (se == I.Var (paramName p)) $
-                letBindNames [paramName p] $
-                  BasicOp $
-                    case se of
-                      I.Var v
-                        | not $ primType $ paramType p ->
-                          Reshape (map DimCoercion $ arrayDims $ paramType p) v
-                      _ -> SubExp se
-            internaliseExp "loop_cond" cond
-          loop_end_cond <- bodyBind loop_end_cond_body
-
-          return
-            ( shapeargs ++ loop_end_cond ++ ses,
-              ( I.WhileLoop $ I.paramName loop_while,
-                shapepat,
-                loop_while : mergepat',
-                loop_initial_cond : mergeinit
-              )
-            )
-internaliseAppExp desc (E.LetWith name src idxs ve body loc) = do
-  let pat = E.Id (E.identName name) (E.identType name) loc
-      src_t = E.fromStruct <$> E.identType src
-      e = E.Update (E.Var (E.qualName $ E.identName src) src_t loc) idxs ve loc
-  internaliseExp desc $
-    E.AppExp
-      (E.LetPat [] pat e body loc)
-      (Info (AppRes (E.typeOf body) mempty))
-internaliseAppExp desc (E.Match e cs _) = do
-  ses <- internaliseExp (desc ++ "_scrutinee") e
-  case NE.uncons cs of
-    (CasePat pCase eCase _, Nothing) -> do
-      (_, pertinent) <- generateCond pCase ses
-      internalisePat' [] pCase pertinent eCase (internaliseExp desc)
-    (c, Just cs') -> do
-      let CasePat pLast eLast _ = NE.last cs'
-      bFalse <- do
-        (_, pertinent) <- generateCond pLast ses
-        eLast' <- internalisePat' [] pLast pertinent eLast (internaliseBody desc)
-        foldM (\bf c' -> eBody $ return $ generateCaseIf ses c' bf) eLast' $
-          reverse $ NE.init cs'
-      letTupExp' desc =<< generateCaseIf ses c bFalse
-internaliseAppExp desc (E.If ce te fe _) =
-  letTupExp' desc
-    =<< eIf
-      (BasicOp . SubExp <$> internaliseExp1 "cond" ce)
-      (internaliseBody (desc <> "_t") te)
-      (internaliseBody (desc <> "_f") fe)
-internaliseAppExp _ e@E.BinOp {} =
-  error $ "internaliseAppExp: Unexpected BinOp " ++ pretty e
-
-internaliseExp :: String -> E.Exp -> InternaliseM [I.SubExp]
-internaliseExp desc (E.Parens e _) =
-  internaliseExp desc e
-internaliseExp desc (E.QualParens _ e _) =
-  internaliseExp desc e
-internaliseExp desc (E.StringLit vs _) =
-  fmap pure $
-    letSubExp desc $
-      I.BasicOp $ I.ArrayLit (map constant vs) $ I.Prim int8
-internaliseExp _ (E.Var (E.QualName _ name) _ _) = do
-  subst <- lookupSubst name
-  case subst of
-    Just substs -> return substs
-    Nothing -> pure [I.Var name]
-internaliseExp desc (E.AppExp e (Info appres)) = do
-  ses <- internaliseAppExp desc e
-  bindExtSizes appres ses
-  pure ses
-
--- XXX: we map empty records and tuples to units, because otherwise
--- arrays of unit will lose their sizes.
-internaliseExp _ (E.TupLit [] _) =
-  return [constant UnitValue]
-internaliseExp _ (E.RecordLit [] _) =
-  return [constant UnitValue]
-internaliseExp desc (E.TupLit es _) = concat <$> mapM (internaliseExp desc) es
-internaliseExp desc (E.RecordLit orig_fields _) =
-  concatMap snd . sortFields . M.unions <$> mapM internaliseField orig_fields
-  where
-    internaliseField (E.RecordFieldExplicit name e _) =
-      M.singleton name <$> internaliseExp desc e
-    internaliseField (E.RecordFieldImplicit name t loc) =
-      internaliseField $
-        E.RecordFieldExplicit
-          (baseName name)
-          (E.Var (E.qualName name) t loc)
-          loc
-internaliseExp desc (E.ArrayLit es (Info arr_t) loc)
-  -- If this is a multidimensional array literal of primitives, we
-  -- treat it specially by flattening it out followed by a reshape.
-  -- This cuts down on the amount of statements that are produced, and
-  -- thus allows us to efficiently handle huge array literals - a
-  -- corner case, but an important one.
-  | Just ((eshape, e') : es') <- mapM isArrayLiteral es,
-    not $ null eshape,
-    all ((eshape ==) . fst) es',
-    Just basetype <- E.peelArray (length eshape) arr_t = do
-    let flat_lit = E.ArrayLit (e' ++ concatMap snd es') (Info basetype) loc
-        new_shape = length es : eshape
-    flat_arrs <- internaliseExpToVars "flat_literal" flat_lit
-    forM flat_arrs $ \flat_arr -> do
-      flat_arr_t <- lookupType flat_arr
-      let new_shape' =
-            reshapeOuter
-              (map (DimNew . intConst Int64 . toInteger) new_shape)
-              1
-              $ I.arrayShape flat_arr_t
-      letSubExp desc $ I.BasicOp $ I.Reshape new_shape' flat_arr
-  | otherwise = do
-    es' <- mapM (internaliseExp "arr_elem") es
-    arr_t_ext <- internaliseType $ E.toStruct arr_t
-
-    rowtypes <-
-      case mapM (fmap rowType . hasStaticShape . I.fromDecl) arr_t_ext of
-        Just ts -> pure ts
-        Nothing ->
-          -- XXX: the monomorphiser may create single-element array
-          -- literals with an unknown row type.  In those cases we
-          -- need to look at the types of the actual elements.
-          -- Fixing this in the monomorphiser is a lot more tricky
-          -- than just working around it here.
-          case es' of
-            [] -> error $ "internaliseExp ArrayLit: existential type: " ++ pretty arr_t
-            e' : _ -> mapM subExpType e'
-
-    let arraylit ks rt = do
-          ks' <-
-            mapM
-              ( ensureShape
-                  "shape of element differs from shape of first element"
-                  loc
-                  rt
-                  "elem_reshaped"
-              )
-              ks
-          return $ I.BasicOp $ I.ArrayLit ks' rt
-
-    letSubExps desc
-      =<< if null es'
-        then mapM (arraylit []) rowtypes
-        else zipWithM arraylit (transpose es') rowtypes
-  where
-    isArrayLiteral :: E.Exp -> Maybe ([Int], [E.Exp])
-    isArrayLiteral (E.ArrayLit inner_es _ _) = do
-      (eshape, e) : inner_es' <- mapM isArrayLiteral inner_es
-      guard $ all ((eshape ==) . fst) inner_es'
-      return (length inner_es : eshape, e ++ concatMap snd inner_es')
-    isArrayLiteral e =
-      Just ([], [e])
-internaliseExp desc (E.Ascript e _ _) =
-  internaliseExp desc e
-internaliseExp desc (E.Negate e _) = do
-  e' <- internaliseExp1 "negate_arg" e
-  et <- subExpType e'
-  case et of
-    I.Prim (I.IntType t) ->
-      letTupExp' desc $ I.BasicOp $ I.BinOp (I.Sub t I.OverflowWrap) (I.intConst t 0) e'
-    I.Prim (I.FloatType t) ->
-      letTupExp' desc $ I.BasicOp $ I.BinOp (I.FSub t) (I.floatConst t 0) e'
-    _ -> error "Futhark.Internalise.internaliseExp: non-numeric type in Negate"
-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 slice
-
-  let comb sname ve' = do
-        sname_t <- lookupType sname
-        let full_slice = fullSlice sname_t idxs'
-            rowtype = sname_t `setArrayDims` sliceDims full_slice
-        ve'' <-
-          ensureShape
-            "shape of value does not match shape of source array"
-            loc
-            rowtype
-            "lw_val_correct_shape"
-            ve'
-        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
-  ve' <- internaliseExp desc ve
-  replace (E.typeOf src `setAliases` ()) fields ve' src'
-  where
-    replace (E.Scalar (E.Record m)) (f : fs) ve' src'
-      | Just t <- M.lookup f m = do
-        i <-
-          fmap sum $
-            mapM (internalisedTypeSize . snd) $
-              takeWhile ((/= f) . fst) $ sortFields m
-        k <- internalisedTypeSize t
-        let (bef, to_update, aft) = splitAt3 i k src'
-        src'' <- replace t fs ve' to_update
-        return $ bef ++ src'' ++ aft
-    replace _ _ ve' _ = return ve'
-internaliseExp desc (E.Attr attr e _) =
-  local f $ internaliseExp desc e
-  where
-    attrs = oneAttr $ internaliseAttr attr
-    f env
-      | "unsafe" `inAttrs` attrs,
-        not $ envSafe env =
-        env {envDoBoundsChecks = False}
-      | otherwise =
-        env {envAttrs = envAttrs env <> attrs}
-internaliseExp desc (E.Assert e1 e2 (Info check) loc) = do
-  e1' <- internaliseExp1 "assert_cond" e1
-  c <- assert "assert_c" e1' (errorMsg [ErrorString $ "Assertion is false: " <> check]) loc
-  -- Make sure there are some bindings to certify.
-  certifying c $ mapM rebind =<< internaliseExp desc e2
-  where
-    rebind v = do
-      v' <- newVName "assert_res"
-      letBindNames [v'] $ I.BasicOp $ I.SubExp v
-      return $ I.Var v'
-internaliseExp _ (E.Constr c es (Info (E.Scalar (E.Sum fs))) _) = do
-  (ts, constr_map) <- internaliseSumType $ M.map (map E.toStruct) fs
-  es' <- concat <$> mapM (internaliseExp "payload") es
-
-  let noExt _ = return $ intConst Int64 0
-  ts' <- instantiateShapes noExt $ map fromDecl ts
-
-  case M.lookup c constr_map of
-    Just (i, js) ->
-      (intConst Int8 (toInteger i) :) <$> clauses 0 ts' (zip js es')
-    Nothing ->
-      error "internaliseExp Constr: missing constructor"
-  where
-    clauses j (t : ts) js_to_es
-      | Just e <- j `lookup` js_to_es =
-        (e :) <$> clauses (j + 1) ts js_to_es
-      | otherwise = do
-        blank <- letSubExp "zero" =<< eBlank t
-        (blank :) <$> clauses (j + 1) ts js_to_es
-    clauses _ [] _ =
-      return []
-internaliseExp _ (E.Constr _ _ (Info t) loc) =
-  error $ "internaliseExp: constructor with type " ++ pretty t ++ " at " ++ locStr loc
--- The "interesting" cases are over, now it's mostly boilerplate.
-
-internaliseExp _ (E.Literal v _) =
-  return [I.Constant $ internalisePrimValue v]
-internaliseExp _ (E.IntLit v (Info t) _) =
-  case t of
-    E.Scalar (E.Prim (E.Signed it)) ->
-      return [I.Constant $ I.IntValue $ intValue it v]
-    E.Scalar (E.Prim (E.Unsigned it)) ->
-      return [I.Constant $ I.IntValue $ intValue it v]
-    E.Scalar (E.Prim (E.FloatType ft)) ->
-      return [I.Constant $ I.FloatValue $ floatValue ft v]
-    _ -> error $ "internaliseExp: nonsensical type for integer literal: " ++ pretty t
-internaliseExp _ (E.FloatLit v (Info t) _) =
-  case t of
-    E.Scalar (E.Prim (E.FloatType ft)) ->
-      return [I.Constant $ I.FloatValue $ floatValue ft v]
-    _ -> error $ "internaliseExp: nonsensical type for float literal: " ++ pretty t
--- Builtin operators are handled specially because they are
--- overloaded.
-internaliseExp desc (E.Project k e (Info rt) _) = do
-  n <- internalisedTypeSize $ rt `setAliases` ()
-  i' <- fmap sum $
-    mapM internalisedTypeSize $
-      case E.typeOf e `setAliases` () of
-        E.Scalar (Record fs) ->
-          map snd $ takeWhile ((/= k) . fst) $ sortFields fs
-        t -> [t]
-  take n . drop i' <$> internaliseExp desc e
-internaliseExp _ e@E.Lambda {} =
-  error $ "internaliseExp: Unexpected lambda at " ++ locStr (srclocOf e)
-internaliseExp _ e@E.OpSection {} =
-  error $ "internaliseExp: Unexpected operator section at " ++ locStr (srclocOf e)
-internaliseExp _ e@E.OpSectionLeft {} =
-  error $ "internaliseExp: Unexpected left operator section at " ++ locStr (srclocOf e)
-internaliseExp _ e@E.OpSectionRight {} =
-  error $ "internaliseExp: Unexpected right operator section at " ++ locStr (srclocOf e)
-internaliseExp _ e@E.ProjectSection {} =
-  error $ "internaliseExp: Unexpected projection section at " ++ locStr (srclocOf e)
-internaliseExp _ e@E.IndexSection {} =
-  error $ "internaliseExp: Unexpected index section at " ++ locStr (srclocOf e)
-
-internaliseArg :: String -> (E.Exp, Maybe VName) -> InternaliseM [SubExp]
-internaliseArg desc (arg, argdim) = do
-  arg' <- internaliseExp desc arg
-  case (arg', argdim) of
-    ([se], Just d) -> letBindNames [d] $ BasicOp $ SubExp se
-    _ -> return ()
-  return arg'
-
-subExpPrimType :: I.SubExp -> InternaliseM I.PrimType
-subExpPrimType = fmap I.elemType . subExpType
-
-generateCond :: E.Pattern -> [I.SubExp] -> InternaliseM (I.SubExp, [I.SubExp])
-generateCond orig_p orig_ses = do
-  (cmps, pertinent, _) <- compares orig_p orig_ses
-  cmp <- letSubExp "matches" =<< eAll cmps
-  return (cmp, pertinent)
-  where
-    -- Literals are always primitive values.
-    compares (E.PatternLit l t _) (se : ses) = do
-      e' <- case l of
-        PatLitPrim v -> pure $ constant $ internalisePrimValue v
-        PatLitInt x -> internaliseExp1 "constant" $ E.IntLit x t mempty
-        PatLitFloat x -> internaliseExp1 "constant" $ E.FloatLit x t mempty
-      t' <- subExpPrimType se
-      cmp <- letSubExp "match_lit" $ I.BasicOp $ I.CmpOp (I.CmpEq t') e' se
-      return ([cmp], [se], ses)
-    compares (E.PatternConstr c (Info (E.Scalar (E.Sum fs))) pats _) (se : ses) = do
-      (payload_ts, m) <- internaliseSumType $ M.map (map toStruct) fs
-      case M.lookup c m of
-        Just (i, payload_is) -> do
-          let i' = intConst Int8 $ toInteger i
-          let (payload_ses, ses') = splitAt (length payload_ts) ses
-          cmp <- letSubExp "match_constr" $ I.BasicOp $ I.CmpOp (I.CmpEq int8) i' se
-          (cmps, pertinent, _) <- comparesMany pats $ map (payload_ses !!) payload_is
-          return (cmp : cmps, pertinent, ses')
-        Nothing ->
-          error "generateCond: missing constructor"
-    compares (E.PatternConstr _ (Info t) _ _) _ =
-      error $ "generateCond: PatternConstr has nonsensical type: " ++ pretty t
-    compares (E.Id _ t loc) ses =
-      compares (E.Wildcard t loc) ses
-    compares (E.Wildcard (Info t) _) ses = do
-      n <- internalisedTypeSize $ E.toStruct t
-      let (id_ses, rest_ses) = splitAt n ses
-      return ([], id_ses, rest_ses)
-    compares (E.PatternParens pat _) ses =
-      compares pat ses
-    -- XXX: treat empty tuples and records as bool.
-    compares (E.TuplePattern [] loc) ses =
-      compares (E.Wildcard (Info $ E.Scalar $ E.Prim E.Bool) loc) ses
-    compares (E.RecordPattern [] loc) ses =
-      compares (E.Wildcard (Info $ E.Scalar $ E.Prim E.Bool) loc) ses
-    compares (E.TuplePattern pats _) ses =
-      comparesMany pats ses
-    compares (E.RecordPattern fs _) ses =
-      comparesMany (map snd $ E.sortFields $ M.fromList fs) ses
-    compares (E.PatternAscription pat _ _) ses =
-      compares pat ses
-    compares pat [] =
-      error $ "generateCond: No values left for pattern " ++ pretty pat
-
-    comparesMany [] ses = return ([], [], ses)
-    comparesMany (pat : pats) ses = do
-      (cmps1, pertinent1, ses') <- compares pat ses
-      (cmps2, pertinent2, ses'') <- comparesMany pats ses'
-      return
-        ( cmps1 <> cmps2,
-          pertinent1 <> pertinent2,
-          ses''
-        )
-
-generateCaseIf :: [I.SubExp] -> Case -> I.Body -> InternaliseM I.Exp
-generateCaseIf ses (CasePat p eCase _) bFail = do
-  (cond, pertinent) <- generateCond p ses
-  eCase' <- internalisePat' [] p pertinent eCase (internaliseBody "case")
-  eIf (eSubExp cond) (return eCase') (return bFail)
-
-internalisePat ::
-  String ->
-  [E.SizeBinder VName] ->
-  E.Pattern ->
-  E.Exp ->
-  E.Exp ->
-  (E.Exp -> InternaliseM a) ->
-  InternaliseM a
-internalisePat desc sizes p e body m = do
-  ses <- internaliseExp desc' e
-  internalisePat' sizes p ses body m
-  where
-    desc' = case S.toList $ E.patternIdents p of
-      [v] -> baseString $ E.identName v
-      _ -> desc
-
-internalisePat' ::
-  [E.SizeBinder VName] ->
-  E.Pattern ->
-  [I.SubExp] ->
-  E.Exp ->
-  (E.Exp -> InternaliseM a) ->
-  InternaliseM a
-internalisePat' sizes p ses body m = do
-  ses_ts <- mapM subExpType ses
-  stmPattern p ses_ts $ \pat_names -> do
-    bindExtSizes (AppRes (E.patternType p) (map E.sizeName sizes)) ses
-    forM_ (zip pat_names ses) $ \(v, se) ->
-      letBindNames [v] $ I.BasicOp $ I.SubExp se
-    m body
-
-internaliseSlice ::
-  SrcLoc ->
-  [SubExp] ->
-  [E.DimIndex] ->
-  InternaliseM ([I.DimIndex SubExp], Certificates)
-internaliseSlice loc dims idxs = do
-  (idxs', oks, parts) <- unzip3 <$> zipWithM internaliseDimIndex dims idxs
-  ok <- letSubExp "index_ok" =<< eAll oks
-  let msg =
-        errorMsg $
-          ["Index ["] ++ intercalate [", "] parts
-            ++ ["] out of bounds for array of shape ["]
-            ++ intersperse "][" (map ErrorInt64 $ take (length idxs) dims)
-            ++ ["]."]
-  c <- assert "index_certs" ok msg loc
-  return (idxs', c)
-
-internaliseDimIndex ::
-  SubExp ->
-  E.DimIndex ->
-  InternaliseM (I.DimIndex SubExp, SubExp, [ErrorMsgPart SubExp])
-internaliseDimIndex w (E.DimFix i) = do
-  (i', _) <- internaliseDimExp "i" i
-  let lowerBound =
-        I.BasicOp $
-          I.CmpOp (I.CmpSle I.Int64) (I.constant (0 :: I.Int64)) i'
-      upperBound =
-        I.BasicOp $
-          I.CmpOp (I.CmpSlt I.Int64) i' w
-  ok <- letSubExp "bounds_check" =<< eBinOp I.LogAnd (pure lowerBound) (pure upperBound)
-  return (I.DimFix i', ok, [ErrorInt64 i'])
-
--- Special-case an important common case that otherwise leads to horrible code.
-internaliseDimIndex
-  w
-  ( E.DimSlice
-      Nothing
-      Nothing
-      (Just (E.Negate (E.IntLit 1 _ _) _))
-    ) = do
-    w_minus_1 <-
-      letSubExp "w_minus_1" $
-        BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) w one
-    return
-      ( I.DimSlice w_minus_1 w $ intConst Int64 (-1),
-        constant True,
-        mempty
-      )
-    where
-      one = constant (1 :: Int64)
-internaliseDimIndex w (E.DimSlice i j s) = do
-  s' <- maybe (return one) (fmap fst . internaliseDimExp "s") s
-  s_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum Int64) s'
-  backwards <- letSubExp "backwards" $ I.BasicOp $ I.CmpOp (I.CmpEq int64) s_sign negone
-  w_minus_1 <- letSubExp "w_minus_1" $ BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) w one
-  let i_def =
-        letSubExp "i_def" $
-          I.If
-            backwards
-            (resultBody [w_minus_1])
-            (resultBody [zero])
-            $ ifCommon [I.Prim int64]
-      j_def =
-        letSubExp "j_def" $
-          I.If
-            backwards
-            (resultBody [negone])
-            (resultBody [w])
-            $ ifCommon [I.Prim int64]
-  i' <- maybe i_def (fmap fst . internaliseDimExp "i") i
-  j' <- maybe j_def (fmap fst . internaliseDimExp "j") j
-  j_m_i <- letSubExp "j_m_i" $ BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) j' i'
-  -- Something like a division-rounding-up, but accomodating negative
-  -- operands.
-  let divRounding x y =
-        eBinOp
-          (SQuot Int64 Unsafe)
-          ( eBinOp
-              (Add Int64 I.OverflowWrap)
-              x
-              (eBinOp (Sub Int64 I.OverflowWrap) y (eSignum $ toExp s'))
-          )
-          y
-  n <- letSubExp "n" =<< divRounding (toExp j_m_i) (toExp s')
-
-  -- Bounds checks depend on whether we are slicing forwards or
-  -- backwards.  If forwards, we must check '0 <= i && i <= j'.  If
-  -- backwards, '-1 <= j && j <= i'.  In both cases, we check '0 <=
-  -- i+n*s && i+(n-1)*s < w'.  We only check if the slice is nonempty.
-  empty_slice <- letSubExp "empty_slice" $ I.BasicOp $ I.CmpOp (CmpEq int64) n zero
-
-  m <- letSubExp "m" $ I.BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) n one
-  m_t_s <- letSubExp "m_t_s" $ I.BasicOp $ I.BinOp (Mul Int64 I.OverflowWrap) m s'
-  i_p_m_t_s <- letSubExp "i_p_m_t_s" $ I.BasicOp $ I.BinOp (Add Int64 I.OverflowWrap) i' m_t_s
-  zero_leq_i_p_m_t_s <-
-    letSubExp "zero_leq_i_p_m_t_s" $
-      I.BasicOp $ I.CmpOp (I.CmpSle Int64) zero i_p_m_t_s
-  i_p_m_t_s_leq_w <-
-    letSubExp "i_p_m_t_s_leq_w" $
-      I.BasicOp $ I.CmpOp (I.CmpSle Int64) i_p_m_t_s w
-  i_p_m_t_s_lth_w <-
-    letSubExp "i_p_m_t_s_leq_w" $
-      I.BasicOp $ I.CmpOp (I.CmpSlt Int64) i_p_m_t_s w
-
-  zero_lte_i <- letSubExp "zero_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) zero i'
-  i_lte_j <- letSubExp "i_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) i' j'
-  forwards_ok <-
-    letSubExp "forwards_ok"
-      =<< eAll [zero_lte_i, zero_lte_i, i_lte_j, zero_leq_i_p_m_t_s, i_p_m_t_s_lth_w]
-
-  negone_lte_j <- letSubExp "negone_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) negone j'
-  j_lte_i <- letSubExp "j_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) j' i'
-  backwards_ok <-
-    letSubExp "backwards_ok"
-      =<< eAll
-        [negone_lte_j, negone_lte_j, j_lte_i, zero_leq_i_p_m_t_s, i_p_m_t_s_leq_w]
-
-  slice_ok <-
-    letSubExp "slice_ok" $
-      I.If
-        backwards
-        (resultBody [backwards_ok])
-        (resultBody [forwards_ok])
-        $ ifCommon [I.Prim I.Bool]
-  ok_or_empty <-
-    letSubExp "ok_or_empty" $
-      I.BasicOp $ I.BinOp I.LogOr empty_slice slice_ok
-
-  let parts = case (i, j, s) of
-        (_, _, Just {}) ->
-          [ maybe "" (const $ ErrorInt64 i') i,
-            ":",
-            maybe "" (const $ ErrorInt64 j') j,
-            ":",
-            ErrorInt64 s'
-          ]
-        (_, Just {}, _) ->
-          [ maybe "" (const $ ErrorInt64 i') i,
-            ":",
-            ErrorInt64 j'
-          ]
-            ++ maybe mempty (const [":", ErrorInt64 s']) s
-        (_, Nothing, Nothing) ->
-          [ErrorInt64 i', ":"]
-  return (I.DimSlice i' n s', ok_or_empty, parts)
-  where
-    zero = constant (0 :: Int64)
-    negone = constant (-1 :: Int64)
-    one = constant (1 :: Int64)
-
-internaliseScanOrReduce ::
-  String ->
-  String ->
-  (SubExp -> I.Lambda -> [SubExp] -> [VName] -> InternaliseM (SOAC SOACS)) ->
-  (E.Exp, E.Exp, E.Exp, SrcLoc) ->
-  InternaliseM [SubExp]
-internaliseScanOrReduce desc what f (lam, ne, arr, loc) = do
-  arrs <- internaliseExpToVars (what ++ "_arr") arr
-  nes <- internaliseExp (what ++ "_ne") ne
-  nes' <- forM (zip nes arrs) $ \(ne', arr') -> do
-    rowtype <- I.stripArray 1 <$> lookupType arr'
-    ensureShape
-      "Row shape of input array does not match shape of neutral element"
-      loc
-      rowtype
-      (what ++ "_ne_right_shape")
-      ne'
-  nests <- mapM I.subExpType nes'
-  arrts <- mapM lookupType arrs
-  lam' <- internaliseFoldLambda internaliseLambda lam nests arrts
-  w <- arraysSize 0 <$> mapM lookupType arrs
-  letTupExp' desc . I.Op =<< f w lam' nes' arrs
-
-internaliseHist ::
-  String ->
-  E.Exp ->
-  E.Exp ->
-  E.Exp ->
-  E.Exp ->
-  E.Exp ->
-  E.Exp ->
-  SrcLoc ->
-  InternaliseM [SubExp]
-internaliseHist desc rf hist op ne buckets img loc = do
-  rf' <- internaliseExp1 "hist_rf" rf
-  ne' <- internaliseExp "hist_ne" ne
-  hist' <- internaliseExpToVars "hist_hist" hist
-  buckets' <-
-    letExp "hist_buckets" . BasicOp . SubExp
-      =<< internaliseExp1 "hist_buckets" buckets
-  img' <- internaliseExpToVars "hist_img" img
-
-  -- reshape neutral element to have same size as the destination array
-  ne_shp <- forM (zip ne' hist') $ \(n, h) -> do
-    rowtype <- I.stripArray 1 <$> lookupType h
-    ensureShape
-      "Row shape of destination array does not match shape of neutral element"
-      loc
-      rowtype
-      "hist_ne_right_shape"
-      n
-  ne_ts <- mapM I.subExpType ne_shp
-  his_ts <- mapM lookupType hist'
-  op' <- internaliseFoldLambda internaliseLambda op ne_ts his_ts
-
-  -- reshape return type of bucket function to have same size as neutral element
-  -- (modulo the index)
-  bucket_param <- newParam "bucket_p" $ I.Prim int64
-  img_params <- mapM (newParam "img_p" . rowType) =<< mapM lookupType img'
-  let params = bucket_param : img_params
-      rettype = I.Prim int64 : ne_ts
-      body = mkBody mempty $ map (I.Var . paramName) params
-  lam' <-
-    mkLambda params $
-      ensureResultShape
-        "Row shape of value array does not match row shape of hist target"
-        (srclocOf img)
-        rettype
-        =<< bodyBind body
-
-  -- get sizes of histogram and image arrays
-  w_hist <- arraysSize 0 <$> mapM lookupType hist'
-  w_img <- arraysSize 0 <$> mapM lookupType img'
-
-  -- Generate an assertion and reshapes to ensure that buckets' and
-  -- img' are the same size.
-  b_shape <- I.arrayShape <$> lookupType buckets'
-  let b_w = shapeSize 0 b_shape
-  cmp <- letSubExp "bucket_cmp" $ I.BasicOp $ I.CmpOp (I.CmpEq I.int64) b_w w_img
-  c <-
-    assert
-      "bucket_cert"
-      cmp
-      "length of index and value array does not match"
-      loc
-  buckets'' <-
-    certifying c $
-      letExp (baseString buckets') $
-        I.BasicOp $ I.Reshape (reshapeOuter [DimCoercion w_img] 1 b_shape) buckets'
-
-  letTupExp' desc . I.Op $
-    I.Hist w_img [HistOp w_hist rf' hist' ne_shp op'] lam' $ buckets'' : img'
-
-internaliseStreamMap ::
-  String ->
-  StreamOrd ->
-  E.Exp ->
-  E.Exp ->
-  InternaliseM [SubExp]
-internaliseStreamMap desc o lam arr = do
-  arrs <- internaliseExpToVars "stream_input" arr
-  lam' <- internaliseStreamMapLambda internaliseLambda lam $ map I.Var arrs
-  w <- arraysSize 0 <$> mapM lookupType arrs
-  let form = I.Parallel o Commutative (I.Lambda [] (mkBody mempty []) [])
-  letTupExp' desc $ I.Op $ I.Stream w arrs form [] lam'
-
-internaliseStreamRed ::
-  String ->
-  StreamOrd ->
-  Commutativity ->
-  E.Exp ->
-  E.Exp ->
-  E.Exp ->
-  InternaliseM [SubExp]
-internaliseStreamRed desc o comm lam0 lam arr = do
-  arrs <- internaliseExpToVars "stream_input" arr
-  rowts <- mapM (fmap I.rowType . lookupType) arrs
-  (lam_params, lam_body) <-
-    internaliseStreamLambda internaliseLambda lam rowts
-  let (chunk_param, _, lam_val_params) =
-        partitionChunkedFoldParameters 0 lam_params
-
-  -- Synthesize neutral elements by applying the fold function
-  -- to an empty chunk.
-  letBindNames [I.paramName chunk_param] $
-    I.BasicOp $ I.SubExp $ constant (0 :: Int64)
-  forM_ lam_val_params $ \p ->
-    letBindNames [I.paramName p] $
-      I.BasicOp $
-        I.Scratch (I.elemType $ I.paramType p) $
-          I.arrayDims $ I.paramType p
-  nes <- bodyBind =<< renameBody lam_body
-
-  nes_ts <- mapM I.subExpType nes
-  outsz <- arraysSize 0 <$> mapM lookupType arrs
-  let acc_arr_tps = [I.arrayOf t (I.Shape [outsz]) NoUniqueness | t <- nes_ts]
-  lam0' <- internaliseFoldLambda internaliseLambda lam0 nes_ts acc_arr_tps
-
-  let lam0_acc_params = take (length nes) $ I.lambdaParams lam0'
-  lam_acc_params <- forM lam0_acc_params $ \p -> do
-    name <- newVName $ baseString $ I.paramName p
-    return p {I.paramName = name}
-
-  -- Make sure the chunk size parameter comes first.
-  let lam_params' = chunk_param : lam_acc_params ++ lam_val_params
-
-  lam' <- mkLambda lam_params' $ do
-    lam_res <- bodyBind lam_body
-    lam_res' <-
-      ensureArgShapes
-        "shape of chunk function result does not match shape of initial value"
-        (srclocOf lam)
-        []
-        (map I.typeOf $ I.lambdaParams lam0')
-        lam_res
-    ensureResultShape
-      "shape of result does not match shape of initial value"
-      (srclocOf lam0)
-      nes_ts
-      =<< ( eLambda lam0' . map eSubExp $
-              map (I.Var . paramName) lam_acc_params ++ lam_res'
-          )
-
-  let form = I.Parallel o comm lam0'
-  w <- arraysSize 0 <$> mapM lookupType arrs
-  letTupExp' desc $ I.Op $ I.Stream w arrs form nes lam'
-
-internaliseStreamAcc ::
-  String ->
-  E.Exp ->
-  Maybe (E.Exp, E.Exp) ->
-  E.Exp ->
-  E.Exp ->
-  InternaliseM [SubExp]
-internaliseStreamAcc desc dest op lam bs = do
-  dest' <- internaliseExpToVars "scatter_dest" dest
-  bs' <- internaliseExpToVars "scatter_input" bs
-
-  acc_cert_v <- newVName "acc_cert"
-  dest_ts <- mapM lookupType dest'
-  let dest_w = arraysSize 0 dest_ts
-      acc_t = Acc acc_cert_v (Shape [dest_w]) (map rowType dest_ts) NoUniqueness
-  acc_p <- newParam "acc_p" acc_t
-  withacc_lam <- mkLambda [Param acc_cert_v (I.Prim I.Unit), acc_p] $ do
-    lam' <-
-      internaliseMapLambda internaliseLambda lam $
-        map I.Var $ paramName acc_p : bs'
-    w <- arraysSize 0 <$> mapM lookupType bs'
-    letTupExp' "acc_res" $ I.Op $ I.Screma w (paramName acc_p : bs') (I.mapSOAC lam')
-
-  op' <-
-    case op of
-      Just (op_lam, ne) -> do
-        ne' <- internaliseExp "hist_ne" ne
-        ne_ts <- mapM I.subExpType ne'
-        (lam_params, lam_body, lam_rettype) <-
-          internaliseLambda op_lam $ ne_ts ++ ne_ts
-        idxp <- newParam "idx" $ I.Prim int64
-        let op_lam' = I.Lambda (idxp : lam_params) lam_body lam_rettype
-        return $ Just (op_lam', ne')
-      Nothing ->
-        return Nothing
-
-  destw <- arraysSize 0 <$> mapM lookupType dest'
-  fmap (map I.Var) $
-    letTupExp desc $ WithAcc [(Shape [destw], dest', op')] withacc_lam
-
-internaliseExp1 :: String -> E.Exp -> InternaliseM I.SubExp
-internaliseExp1 desc e = do
-  vs <- internaliseExp desc e
-  case vs of
-    [se] -> return se
-    _ -> error "Internalise.internaliseExp1: was passed not just a single subexpression"
-
--- | Promote to dimension type as appropriate for the original type.
--- Also return original type.
-internaliseDimExp :: String -> E.Exp -> InternaliseM (I.SubExp, IntType)
-internaliseDimExp s e = do
-  e' <- internaliseExp1 s e
-  case E.typeOf e of
-    E.Scalar (E.Prim (Signed it)) -> (,it) <$> asIntS Int64 e'
-    _ -> error "internaliseDimExp: bad type"
-
-internaliseExpToVars :: String -> E.Exp -> InternaliseM [I.VName]
-internaliseExpToVars desc e =
-  mapM asIdent =<< internaliseExp desc e
-  where
-    asIdent (I.Var v) = return v
-    asIdent se = letExp desc $ I.BasicOp $ I.SubExp se
-
-internaliseOperation ::
-  String ->
-  E.Exp ->
-  (I.VName -> InternaliseM I.BasicOp) ->
-  InternaliseM [I.SubExp]
-internaliseOperation s e op = do
-  vs <- internaliseExpToVars s e
-  letSubExps s =<< mapM (fmap I.BasicOp . op) vs
-
-certifyingNonzero ::
-  SrcLoc ->
-  IntType ->
-  SubExp ->
-  InternaliseM a ->
-  InternaliseM a
-certifyingNonzero loc t x m = do
-  zero <-
-    letSubExp "zero" $
-      I.BasicOp $
-        CmpOp (CmpEq (IntType t)) x (intConst t 0)
-  nonzero <- letSubExp "nonzero" $ I.BasicOp $ UnOp Not zero
-  c <- assert "nonzero_cert" nonzero "division by zero" loc
-  certifying c m
-
-certifyingNonnegative ::
-  SrcLoc ->
-  IntType ->
-  SubExp ->
-  InternaliseM a ->
-  InternaliseM a
-certifyingNonnegative loc t x m = do
-  nonnegative <-
-    letSubExp "nonnegative" $
-      I.BasicOp $
-        CmpOp (CmpSle t) (intConst t 0) x
-  c <- assert "nonzero_cert" nonnegative "negative exponent" loc
-  certifying c m
-
-internaliseBinOp ::
-  SrcLoc ->
-  String ->
-  E.BinOp ->
-  I.SubExp ->
-  I.SubExp ->
-  E.PrimType ->
-  E.PrimType ->
-  InternaliseM [I.SubExp]
-internaliseBinOp _ desc E.Plus x y (E.Signed t) _ =
-  simpleBinOp desc (I.Add t I.OverflowWrap) x y
-internaliseBinOp _ desc E.Plus x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Add t I.OverflowWrap) x y
-internaliseBinOp _ desc E.Plus x y (E.FloatType t) _ =
-  simpleBinOp desc (I.FAdd t) x y
-internaliseBinOp _ desc E.Minus x y (E.Signed t) _ =
-  simpleBinOp desc (I.Sub t I.OverflowWrap) x y
-internaliseBinOp _ desc E.Minus x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Sub t I.OverflowWrap) x y
-internaliseBinOp _ desc E.Minus x y (E.FloatType t) _ =
-  simpleBinOp desc (I.FSub t) x y
-internaliseBinOp _ desc E.Times x y (E.Signed t) _ =
-  simpleBinOp desc (I.Mul t I.OverflowWrap) x y
-internaliseBinOp _ desc E.Times x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Mul t I.OverflowWrap) x y
-internaliseBinOp _ desc E.Times x y (E.FloatType t) _ =
-  simpleBinOp desc (I.FMul t) x y
-internaliseBinOp loc desc E.Divide x y (E.Signed t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.SDiv t I.Unsafe) x y
-internaliseBinOp loc desc E.Divide x y (E.Unsigned t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.UDiv t I.Unsafe) x y
-internaliseBinOp _ desc E.Divide x y (E.FloatType t) _ =
-  simpleBinOp desc (I.FDiv t) x y
-internaliseBinOp _ desc E.Pow x y (E.FloatType t) _ =
-  simpleBinOp desc (I.FPow t) x y
-internaliseBinOp loc desc E.Pow x y (E.Signed t) _ =
-  certifyingNonnegative loc t y $
-    simpleBinOp desc (I.Pow t) x y
-internaliseBinOp _ desc E.Pow x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Pow t) x y
-internaliseBinOp loc desc E.Mod x y (E.Signed t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.SMod t I.Unsafe) x y
-internaliseBinOp loc desc E.Mod x y (E.Unsigned t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.UMod t I.Unsafe) x y
-internaliseBinOp _ desc E.Mod x y (E.FloatType t) _ =
-  simpleBinOp desc (I.FMod t) x y
-internaliseBinOp loc desc E.Quot x y (E.Signed t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.SQuot t I.Unsafe) x y
-internaliseBinOp loc desc E.Quot x y (E.Unsigned t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.UDiv t I.Unsafe) x y
-internaliseBinOp loc desc E.Rem x y (E.Signed t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.SRem t I.Unsafe) x y
-internaliseBinOp loc desc E.Rem x y (E.Unsigned t) _ =
-  certifyingNonzero loc t y $
-    simpleBinOp desc (I.UMod t I.Unsafe) x y
-internaliseBinOp _ desc E.ShiftR x y (E.Signed t) _ =
-  simpleBinOp desc (I.AShr t) x y
-internaliseBinOp _ desc E.ShiftR x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.LShr t) x y
-internaliseBinOp _ desc E.ShiftL x y (E.Signed t) _ =
-  simpleBinOp desc (I.Shl t) x y
-internaliseBinOp _ desc E.ShiftL x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Shl t) x y
-internaliseBinOp _ desc E.Band x y (E.Signed t) _ =
-  simpleBinOp desc (I.And t) x y
-internaliseBinOp _ desc E.Band x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.And t) x y
-internaliseBinOp _ desc E.Xor x y (E.Signed t) _ =
-  simpleBinOp desc (I.Xor t) x y
-internaliseBinOp _ desc E.Xor x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Xor t) x y
-internaliseBinOp _ desc E.Bor x y (E.Signed t) _ =
-  simpleBinOp desc (I.Or t) x y
-internaliseBinOp _ desc E.Bor x y (E.Unsigned t) _ =
-  simpleBinOp desc (I.Or t) x y
-internaliseBinOp _ desc E.Equal x y t _ =
-  simpleCmpOp desc (I.CmpEq $ internalisePrimType t) x y
-internaliseBinOp _ desc E.NotEqual x y t _ = do
-  eq <- letSubExp (desc ++ "true") $ I.BasicOp $ I.CmpOp (I.CmpEq $ internalisePrimType t) x y
-  fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp I.Not eq
-internaliseBinOp _ desc E.Less x y (E.Signed t) _ =
-  simpleCmpOp desc (I.CmpSlt t) x y
-internaliseBinOp _ desc E.Less x y (E.Unsigned t) _ =
-  simpleCmpOp desc (I.CmpUlt t) x y
-internaliseBinOp _ desc E.Leq x y (E.Signed t) _ =
-  simpleCmpOp desc (I.CmpSle t) x y
-internaliseBinOp _ desc E.Leq x y (E.Unsigned t) _ =
-  simpleCmpOp desc (I.CmpUle t) x y
-internaliseBinOp _ desc E.Greater x y (E.Signed t) _ =
-  simpleCmpOp desc (I.CmpSlt t) y x -- Note the swapped x and y
-internaliseBinOp _ desc E.Greater x y (E.Unsigned t) _ =
-  simpleCmpOp desc (I.CmpUlt t) y x -- Note the swapped x and y
-internaliseBinOp _ desc E.Geq x y (E.Signed t) _ =
-  simpleCmpOp desc (I.CmpSle t) y x -- Note the swapped x and y
-internaliseBinOp _ desc E.Geq x y (E.Unsigned t) _ =
-  simpleCmpOp desc (I.CmpUle t) y x -- Note the swapped x and y
-internaliseBinOp _ desc E.Less x y (E.FloatType t) _ =
-  simpleCmpOp desc (I.FCmpLt t) x y
-internaliseBinOp _ desc E.Leq x y (E.FloatType t) _ =
-  simpleCmpOp desc (I.FCmpLe t) x y
-internaliseBinOp _ desc E.Greater x y (E.FloatType t) _ =
-  simpleCmpOp desc (I.FCmpLt t) y x -- Note the swapped x and y
-internaliseBinOp _ desc E.Geq x y (E.FloatType t) _ =
-  simpleCmpOp desc (I.FCmpLe t) y x -- Note the swapped x and y
-
--- Relational operators for booleans.
-internaliseBinOp _ desc E.Less x y E.Bool _ =
-  simpleCmpOp desc I.CmpLlt x y
-internaliseBinOp _ desc E.Leq x y E.Bool _ =
-  simpleCmpOp desc I.CmpLle x y
-internaliseBinOp _ desc E.Greater x y E.Bool _ =
-  simpleCmpOp desc I.CmpLlt y x -- Note the swapped x and y
-internaliseBinOp _ desc E.Geq x y E.Bool _ =
-  simpleCmpOp desc I.CmpLle y x -- Note the swapped x and y
-internaliseBinOp _ _ op _ _ t1 t2 =
-  error $
-    "Invalid binary operator " ++ pretty op
-      ++ " with operand types "
-      ++ pretty t1
-      ++ ", "
-      ++ pretty t2
-
-simpleBinOp ::
-  String ->
-  I.BinOp ->
-  I.SubExp ->
-  I.SubExp ->
-  InternaliseM [I.SubExp]
-simpleBinOp desc bop x y =
-  letTupExp' desc $ I.BasicOp $ I.BinOp bop x y
-
-simpleCmpOp ::
-  String ->
-  I.CmpOp ->
-  I.SubExp ->
-  I.SubExp ->
-  InternaliseM [I.SubExp]
-simpleCmpOp desc op x y =
-  letTupExp' desc $ I.BasicOp $ I.CmpOp op x y
-
-findFuncall ::
-  E.AppExp ->
-  InternaliseM
-    ( E.QualName VName,
-      [(E.Exp, Maybe VName)]
-    )
-findFuncall (E.Apply f arg (Info (_, argext)) _)
-  | E.AppExp f_e _ <- f = do
-    (fname, args) <- findFuncall f_e
-    return (fname, args ++ [(arg, argext)])
-  | E.Var fname _ _ <- f =
-    return (fname, [(arg, argext)])
-findFuncall e =
-  error $ "Invalid function expression in application: " ++ pretty e
-
--- The type of a body.  Watch out: this only works for the degenerate
--- case where the body does not already return its context.
-bodyExtType :: Body -> InternaliseM [ExtType]
-bodyExtType (Body _ stms res) =
-  existentialiseExtTypes (M.keys stmsscope) . staticShapes
-    <$> extendedScope (traverse subExpType res) stmsscope
-  where
-    stmsscope = scopeOf stms
-
-internaliseLambda :: InternaliseLambda
-internaliseLambda (E.Parens e _) rowtypes =
-  internaliseLambda e rowtypes
-internaliseLambda (E.Lambda params body _ (Info (_, rettype)) _) rowtypes =
-  bindingLambdaParams params rowtypes $ \params' -> do
-    body' <- internaliseBody "lam" body
-    rettype' <- internaliseLambdaReturnType rettype =<< bodyExtType body'
-    return (params', body', rettype')
-internaliseLambda e _ = error $ "internaliseLambda: unexpected expression:\n" ++ pretty e
-
--- | Some operators and functions are overloaded or otherwise special
--- - we detect and treat them here.
-isOverloadedFunction ::
-  E.QualName VName ->
-  [E.Exp] ->
-  SrcLoc ->
-  Maybe (String -> InternaliseM [SubExp])
-isOverloadedFunction qname args loc = do
-  guard $ baseTag (qualLeaf qname) <= maxIntrinsicTag
-  let handlers =
-        [ handleSign,
-          handleIntrinsicOps,
-          handleOps,
-          handleSOACs,
-          handleAccs,
-          handleRest
-        ]
-  msum [h args $ baseString $ qualLeaf qname | h <- handlers]
-  where
-    handleSign [x] "sign_i8" = Just $ toSigned I.Int8 x
-    handleSign [x] "sign_i16" = Just $ toSigned I.Int16 x
-    handleSign [x] "sign_i32" = Just $ toSigned I.Int32 x
-    handleSign [x] "sign_i64" = Just $ toSigned I.Int64 x
-    handleSign [x] "unsign_i8" = Just $ toUnsigned I.Int8 x
-    handleSign [x] "unsign_i16" = Just $ toUnsigned I.Int16 x
-    handleSign [x] "unsign_i32" = Just $ toUnsigned I.Int32 x
-    handleSign [x] "unsign_i64" = Just $ toUnsigned I.Int64 x
-    handleSign _ _ = Nothing
-
-    handleIntrinsicOps [x] s
-      | Just unop <- find ((== s) . pretty) allUnOps = Just $ \desc -> do
-        x' <- internaliseExp1 "x" x
-        fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp unop x'
-    handleIntrinsicOps [TupLit [x, y] _] s
-      | Just bop <- find ((== s) . pretty) allBinOps = Just $ \desc -> do
-        x' <- internaliseExp1 "x" x
-        y' <- internaliseExp1 "y" y
-        fmap pure $ letSubExp desc $ I.BasicOp $ I.BinOp bop x' y'
-      | Just cmp <- find ((== s) . pretty) allCmpOps = Just $ \desc -> do
-        x' <- internaliseExp1 "x" x
-        y' <- internaliseExp1 "y" y
-        fmap pure $ letSubExp desc $ I.BasicOp $ I.CmpOp cmp x' y'
-    handleIntrinsicOps [x] s
-      | Just conv <- find ((== s) . pretty) allConvOps = Just $ \desc -> do
-        x' <- internaliseExp1 "x" x
-        fmap pure $ letSubExp desc $ I.BasicOp $ I.ConvOp conv x'
-    handleIntrinsicOps _ _ = Nothing
-
-    -- Short-circuiting operators are magical.
-    handleOps [x, y] "&&" = Just $ \desc ->
-      internaliseExp desc $
-        E.AppExp
-          (E.If x y (E.Literal (E.BoolValue False) mempty) mempty)
-          (Info $ AppRes (E.Scalar $ E.Prim E.Bool) [])
-    handleOps [x, y] "||" = Just $ \desc ->
-      internaliseExp desc $
-        E.AppExp
-          (E.If x (E.Literal (E.BoolValue True) mempty) y mempty)
-          (Info $ AppRes (E.Scalar $ E.Prim E.Bool) [])
-    -- Handle equality and inequality specially, to treat the case of
-    -- arrays.
-    handleOps [xe, ye] op
-      | Just cmp_f <- isEqlOp op = Just $ \desc -> do
-        xe' <- internaliseExp "x" xe
-        ye' <- internaliseExp "y" ye
-        rs <- zipWithM (doComparison desc) xe' ye'
-        cmp_f desc =<< letSubExp "eq" =<< eAll rs
-      where
-        isEqlOp "!=" = Just $ \desc eq ->
-          letTupExp' desc $ I.BasicOp $ I.UnOp I.Not eq
-        isEqlOp "==" = Just $ \_ eq ->
-          return [eq]
-        isEqlOp _ = Nothing
-
-        doComparison desc x y = do
-          x_t <- I.subExpType x
-          y_t <- I.subExpType y
-          case x_t of
-            I.Prim t -> letSubExp desc $ I.BasicOp $ I.CmpOp (I.CmpEq t) x y
-            _ -> do
-              let x_dims = I.arrayDims x_t
-                  y_dims = I.arrayDims y_t
-              dims_match <- forM (zip x_dims y_dims) $ \(x_dim, y_dim) ->
-                letSubExp "dim_eq" $ I.BasicOp $ I.CmpOp (I.CmpEq int64) x_dim y_dim
-              shapes_match <- letSubExp "shapes_match" =<< eAll dims_match
-              compare_elems_body <- runBodyBinder $ do
-                -- Flatten both x and y.
-                x_num_elems <-
-                  letSubExp "x_num_elems"
-                    =<< foldBinOp (I.Mul Int64 I.OverflowUndef) (constant (1 :: Int64)) x_dims
-                x' <- letExp "x" $ I.BasicOp $ I.SubExp x
-                y' <- letExp "x" $ I.BasicOp $ I.SubExp y
-                x_flat <- letExp "x_flat" $ I.BasicOp $ I.Reshape [I.DimNew x_num_elems] x'
-                y_flat <- letExp "y_flat" $ I.BasicOp $ I.Reshape [I.DimNew x_num_elems] y'
-
-                -- Compare the elements.
-                cmp_lam <- cmpOpLambda $ I.CmpEq (elemType x_t)
-                cmps <-
-                  letExp "cmps" $
-                    I.Op $
-                      I.Screma x_num_elems [x_flat, y_flat] (I.mapSOAC cmp_lam)
-
-                -- Check that all were equal.
-                and_lam <- binOpLambda I.LogAnd I.Bool
-                reduce <- I.reduceSOAC [Reduce Commutative and_lam [constant True]]
-                all_equal <- letSubExp "all_equal" $ I.Op $ I.Screma x_num_elems [cmps] reduce
-                return $ resultBody [all_equal]
-
-              letSubExp "arrays_equal" $
-                I.If shapes_match compare_elems_body (resultBody [constant False]) $
-                  ifCommon [I.Prim I.Bool]
-    handleOps [x, y] name
-      | Just bop <- find ((name ==) . pretty) [minBound .. maxBound :: E.BinOp] =
-        Just $ \desc -> do
-          x' <- internaliseExp1 "x" x
-          y' <- internaliseExp1 "y" y
-          case (E.typeOf x, E.typeOf y) of
-            (E.Scalar (E.Prim t1), E.Scalar (E.Prim t2)) ->
-              internaliseBinOp loc desc bop x' y' t1 t2
-            _ -> error "Futhark.Internalise.internaliseExp: non-primitive type in BinOp."
-    handleOps _ _ = Nothing
-
-    handleSOACs [TupLit [lam, arr] _] "map" = Just $ \desc -> do
-      arr' <- internaliseExpToVars "map_arr" arr
-      lam' <- internaliseMapLambda internaliseLambda lam $ map I.Var arr'
-      w <- arraysSize 0 <$> mapM lookupType arr'
-      letTupExp' desc $
-        I.Op $
-          I.Screma w arr' (I.mapSOAC lam')
-    handleSOACs [TupLit [k, lam, arr] _] "partition" = do
-      k' <- fromIntegral <$> fromInt32 k
-      Just $ \_desc -> do
-        arrs <- internaliseExpToVars "partition_input" arr
-        lam' <- internalisePartitionLambda internaliseLambda k' lam $ map I.Var arrs
-        uncurry (++) <$> partitionWithSOACS (fromIntegral k') lam' arrs
-      where
-        fromInt32 (Literal (SignedValue (Int32Value k')) _) = Just k'
-        fromInt32 (IntLit k' (Info (E.Scalar (E.Prim (Signed Int32)))) _) = Just $ fromInteger k'
-        fromInt32 _ = Nothing
-    handleSOACs [TupLit [lam, ne, arr] _] "reduce" = Just $ \desc ->
-      internaliseScanOrReduce desc "reduce" reduce (lam, ne, arr, loc)
-      where
-        reduce w red_lam nes arrs =
-          I.Screma w arrs
-            <$> I.reduceSOAC [Reduce Noncommutative red_lam nes]
-    handleSOACs [TupLit [lam, ne, arr] _] "reduce_comm" = Just $ \desc ->
-      internaliseScanOrReduce desc "reduce" reduce (lam, ne, arr, loc)
-      where
-        reduce w red_lam nes arrs =
-          I.Screma w arrs
-            <$> I.reduceSOAC [Reduce Commutative red_lam nes]
-    handleSOACs [TupLit [lam, ne, arr] _] "scan" = Just $ \desc ->
-      internaliseScanOrReduce desc "scan" reduce (lam, ne, arr, loc)
-      where
-        reduce w scan_lam nes arrs =
-          I.Screma w arrs <$> I.scanSOAC [Scan scan_lam nes]
-    handleSOACs [TupLit [op, f, arr] _] "reduce_stream" = Just $ \desc ->
-      internaliseStreamRed desc InOrder Noncommutative op f arr
-    handleSOACs [TupLit [op, f, arr] _] "reduce_stream_per" = Just $ \desc ->
-      internaliseStreamRed desc Disorder Commutative op f arr
-    handleSOACs [TupLit [f, arr] _] "map_stream" = Just $ \desc ->
-      internaliseStreamMap desc InOrder f arr
-    handleSOACs [TupLit [f, arr] _] "map_stream_per" = Just $ \desc ->
-      internaliseStreamMap desc Disorder f arr
-    handleSOACs [TupLit [rf, dest, op, ne, buckets, img] _] "hist" = Just $ \desc ->
-      internaliseHist desc rf dest op ne buckets img loc
-    handleSOACs _ _ = Nothing
-
-    handleAccs [TupLit [dest, f, bs] _] "scatter_stream" = Just $ \desc ->
-      internaliseStreamAcc desc dest Nothing f bs
-    handleAccs [TupLit [dest, op, ne, f, bs] _] "hist_stream" = Just $ \desc ->
-      internaliseStreamAcc desc dest (Just (op, ne)) f bs
-    handleAccs [TupLit [acc, i, v] _] "acc_write" = Just $ \desc -> do
-      acc' <- head <$> internaliseExpToVars "acc" acc
-      i' <- internaliseExp1 "acc_i" i
-      vs <- internaliseExp "acc_v" v
-      fmap pure $ letSubExp desc $ BasicOp $ UpdateAcc acc' [i'] vs
-    handleAccs _ _ = Nothing
-
-    handleRest [x] "!" = Just $ complementF x
-    handleRest [x] "opaque" = Just $ \desc ->
-      mapM (letSubExp desc . BasicOp . Opaque) =<< internaliseExp "opaque_arg" x
-    handleRest [E.TupLit [a, si, v] _] "scatter" = Just $ scatterF 1 a si v
-    handleRest [E.TupLit [a, si, v] _] "scatter_2d" = Just $ scatterF 2 a si v
-    handleRest [E.TupLit [a, si, v] _] "scatter_3d" = Just $ scatterF 3 a si v
-    handleRest [E.TupLit [n, m, arr] _] "unflatten" = Just $ \desc -> do
-      arrs <- internaliseExpToVars "unflatten_arr" arr
-      n' <- internaliseExp1 "n" n
-      m' <- internaliseExp1 "m" m
-      -- The unflattened dimension needs to have the same number of elements
-      -- as the original dimension.
-      old_dim <- I.arraysSize 0 <$> mapM lookupType arrs
-      dim_ok <-
-        letSubExp "dim_ok"
-          =<< eCmpOp
-            (I.CmpEq I.int64)
-            (eBinOp (I.Mul Int64 I.OverflowUndef) (eSubExp n') (eSubExp m'))
-            (eSubExp old_dim)
-      dim_ok_cert <-
-        assert
-          "dim_ok_cert"
-          dim_ok
-          "new shape has different number of elements than old shape"
-          loc
-      certifying dim_ok_cert $
-        forM arrs $ \arr' -> do
-          arr_t <- lookupType arr'
-          letSubExp desc $
-            I.BasicOp $
-              I.Reshape (reshapeOuter [DimNew n', DimNew m'] 1 $ I.arrayShape arr_t) arr'
-    handleRest [arr] "flatten" = Just $ \desc -> do
-      arrs <- internaliseExpToVars "flatten_arr" arr
-      forM arrs $ \arr' -> do
-        arr_t <- lookupType arr'
-        let n = arraySize 0 arr_t
-            m = arraySize 1 arr_t
-        k <- letSubExp "flat_dim" $ I.BasicOp $ I.BinOp (Mul Int64 I.OverflowUndef) n m
-        letSubExp desc $
-          I.BasicOp $
-            I.Reshape (reshapeOuter [DimNew k] 2 $ I.arrayShape arr_t) arr'
-    handleRest [TupLit [x, y] _] "concat" = Just $ \desc -> do
-      xs <- internaliseExpToVars "concat_x" x
-      ys <- internaliseExpToVars "concat_y" y
-      outer_size <- arraysSize 0 <$> mapM lookupType xs
-      let sumdims xsize ysize =
-            letSubExp "conc_tmp" $
-              I.BasicOp $
-                I.BinOp (I.Add I.Int64 I.OverflowUndef) xsize ysize
-      ressize <-
-        foldM sumdims outer_size
-          =<< mapM (fmap (arraysSize 0) . mapM lookupType) [ys]
-
-      let conc xarr yarr =
-            I.BasicOp $ I.Concat 0 xarr [yarr] ressize
-      letSubExps desc $ zipWith conc xs ys
-    handleRest [TupLit [offset, e] _] "rotate" = Just $ \desc -> do
-      offset' <- internaliseExp1 "rotation_offset" offset
-      internaliseOperation desc e $ \v -> do
-        r <- I.arrayRank <$> lookupType v
-        let zero = intConst Int64 0
-            offsets = offset' : replicate (r -1) zero
-        return $ I.Rotate offsets v
-    handleRest [e] "transpose" = Just $ \desc ->
-      internaliseOperation desc e $ \v -> do
-        r <- I.arrayRank <$> lookupType v
-        return $ I.Rearrange ([1, 0] ++ [2 .. r -1]) v
-    handleRest [TupLit [x, y] _] "zip" = Just $ \desc ->
-      mapM (letSubExp "zip_copy" . BasicOp . Copy)
-        =<< ( (++)
-                <$> internaliseExpToVars (desc ++ "_zip_x") x
-                <*> internaliseExpToVars (desc ++ "_zip_y") y
-            )
-    handleRest [x] "unzip" = Just $ flip internaliseExp x
-    handleRest [x] "trace" = Just $ flip internaliseExp x
-    handleRest [x] "break" = Just $ flip internaliseExp x
-    handleRest _ _ = Nothing
-
-    toSigned int_to e desc = do
-      e' <- internaliseExp1 "trunc_arg" e
-      case E.typeOf e of
-        E.Scalar (E.Prim E.Bool) ->
-          letTupExp' desc $
-            I.If
-              e'
-              (resultBody [intConst int_to 1])
-              (resultBody [intConst int_to 0])
-              $ ifCommon [I.Prim $ I.IntType int_to]
-        E.Scalar (E.Prim (E.Signed int_from)) ->
-          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.SExt int_from int_to) e'
-        E.Scalar (E.Prim (E.Unsigned int_from)) ->
-          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.ZExt int_from int_to) e'
-        E.Scalar (E.Prim (E.FloatType float_from)) ->
-          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.FPToSI float_from int_to) e'
-        _ -> error "Futhark.Internalise: non-numeric type in ToSigned"
-
-    toUnsigned int_to e desc = do
-      e' <- internaliseExp1 "trunc_arg" e
-      case E.typeOf e of
-        E.Scalar (E.Prim E.Bool) ->
-          letTupExp' desc $
-            I.If
-              e'
-              (resultBody [intConst int_to 1])
-              (resultBody [intConst int_to 0])
-              $ ifCommon [I.Prim $ I.IntType int_to]
-        E.Scalar (E.Prim (E.Signed int_from)) ->
-          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.ZExt int_from int_to) e'
-        E.Scalar (E.Prim (E.Unsigned int_from)) ->
-          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.ZExt int_from int_to) e'
-        E.Scalar (E.Prim (E.FloatType float_from)) ->
-          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.FPToUI float_from int_to) e'
-        _ -> error "Futhark.Internalise.internaliseExp: non-numeric type in ToUnsigned"
-
-    complementF e desc = do
-      e' <- internaliseExp1 "complement_arg" e
-      et <- subExpType e'
-      case et of
-        I.Prim (I.IntType t) ->
-          letTupExp' desc $ I.BasicOp $ I.UnOp (I.Complement t) e'
-        I.Prim I.Bool ->
-          letTupExp' desc $ I.BasicOp $ I.UnOp I.Not e'
-        _ ->
-          error "Futhark.Internalise.internaliseExp: non-int/bool type in Complement"
-
-    scatterF dim a si v desc = do
-      si' <- internaliseExpToVars "write_arg_i" si
-      svs <- internaliseExpToVars "write_arg_v" v
-      sas <- internaliseExpToVars "write_arg_a" a
-
-      si_w <- I.arraysSize 0 <$> mapM lookupType si'
-      sv_ts <- mapM lookupType svs
-
-      svs' <- forM (zip svs sv_ts) $ \(sv, sv_t) -> do
-        let sv_shape = I.arrayShape sv_t
-            sv_w = arraySize 0 sv_t
-
-        -- Generate an assertion and reshapes to ensure that sv and si' are the same
-        -- size.
-        cmp <-
-          letSubExp "write_cmp" $
-            I.BasicOp $
-              I.CmpOp (I.CmpEq I.int64) si_w sv_w
-        c <-
-          assert
-            "write_cert"
-            cmp
-            "length of index and value array does not match"
-            loc
-        certifying c $
-          letExp (baseString sv ++ "_write_sv") $
-            I.BasicOp $ I.Reshape (reshapeOuter [DimCoercion si_w] 1 sv_shape) sv
-
-      indexType <- fmap rowType <$> mapM lookupType si'
-      indexName <- mapM (\_ -> newVName "write_index") indexType
-      valueNames <- replicateM (length sv_ts) $ newVName "write_value"
-
-      sa_ts <- mapM lookupType sas
-      let bodyTypes = concat (replicate (length sv_ts) indexType) ++ map (I.stripArray dim) sa_ts
-          paramTypes = indexType <> map rowType sv_ts
-          bodyNames = indexName <> valueNames
-          bodyParams = zipWith I.Param bodyNames paramTypes
-
-      -- This body is pretty boring right now, as every input is exactly the output.
-      -- But it can get funky later on if fused with something else.
-      body <- localScope (scopeOfLParams bodyParams) . buildBody_ $ do
-        let outs = concat (replicate (length valueNames) indexName) ++ valueNames
-        results <- forM outs $ \name ->
-          letSubExp "write_res" $ I.BasicOp $ I.SubExp $ I.Var name
-        ensureResultShape
-          "scatter value has wrong size"
-          loc
-          bodyTypes
-          results
-
-      let lam =
-            I.Lambda
-              { I.lambdaParams = bodyParams,
-                I.lambdaReturnType = bodyTypes,
-                I.lambdaBody = body
-              }
-          sivs = si' <> svs'
-
-      let sa_ws = map (Shape . take dim . arrayDims) sa_ts
-      letTupExp' desc $ I.Op $ I.Scatter si_w lam sivs $ zip3 sa_ws (repeat 1) sas
-
-funcall ::
-  String ->
-  QualName VName ->
-  [SubExp] ->
-  SrcLoc ->
-  InternaliseM ([SubExp], [I.ExtType])
-funcall desc (QualName _ fname) args loc = do
-  (shapes, value_paramts, fun_params, rettype_fun) <-
-    lookupFunction fname
-  argts <- mapM subExpType args
-
-  shapeargs <- argShapes shapes fun_params argts
-  let diets =
-        replicate (length shapeargs) I.ObservePrim
-          ++ map I.diet value_paramts
-  args' <-
-    ensureArgShapes
-      "function arguments of wrong shape"
-      loc
-      (map I.paramName fun_params)
-      (map I.paramType fun_params)
-      (shapeargs ++ args)
-  argts' <- mapM subExpType args'
-  case rettype_fun $ zip args' argts' of
-    Nothing ->
-      error $
-        concat
-          [ "Cannot apply ",
-            pretty fname,
-            " to ",
-            show (length args'),
-            " arguments\n ",
-            pretty args',
-            "\nof types\n ",
-            pretty argts',
-            "\nFunction has ",
-            show (length fun_params),
-            " parameters\n ",
-            pretty fun_params
-          ]
-    Just ts -> do
-      safety <- askSafety
-      attrs <- asks envAttrs
-      ses <-
-        attributing attrs $
-          letTupExp' desc $
-            I.Apply (internaliseFunName fname) (zip args' diets) ts (safety, loc, mempty)
-      return (ses, map I.fromDecl ts)
-
--- Bind existential names defined by an expression, based on the
--- concrete values that expression evaluated to.  This most
--- importantly should be done after function calls, but also
--- everything else that can produce existentials in the source
--- language.
-bindExtSizes :: AppRes -> [SubExp] -> InternaliseM ()
-bindExtSizes (AppRes ret retext) ses = do
-  ts <- internaliseType $ E.toStruct ret
-  ses_ts <- mapM subExpType ses
-
-  let combine t1 t2 =
-        mconcat $ zipWith combine' (arrayExtDims t1) (arrayDims t2)
-      combine' (I.Free (I.Var v)) se
-        | v `elem` retext = M.singleton v se
-      combine' _ _ = mempty
-
-  forM_ (M.toList $ mconcat $ zipWith combine ts ses_ts) $ \(v, se) ->
-    letBindNames [v] $ BasicOp $ SubExp se
-
-askSafety :: InternaliseM Safety
-askSafety = do
-  check <- asks envDoBoundsChecks
-  return $ if check then I.Safe else I.Unsafe
-
--- Implement partitioning using maps, scans and writes.
-partitionWithSOACS :: Int -> I.Lambda -> [I.VName] -> InternaliseM ([I.SubExp], [I.SubExp])
-partitionWithSOACS k lam arrs = do
-  arr_ts <- mapM lookupType arrs
-  let w = arraysSize 0 arr_ts
-  classes_and_increments <- letTupExp "increments" $ I.Op $ I.Screma w arrs (mapSOAC lam)
-  (classes, increments) <- case classes_and_increments of
-    classes : increments -> return (classes, take k increments)
-    _ -> error "partitionWithSOACS"
-
-  add_lam_x_params <-
-    replicateM k $ I.Param <$> newVName "x" <*> pure (I.Prim int64)
-  add_lam_y_params <-
-    replicateM k $ I.Param <$> newVName "y" <*> pure (I.Prim int64)
-  add_lam_body <- runBodyBinder $
-    localScope (scopeOfLParams $ add_lam_x_params ++ add_lam_y_params) $
-      fmap resultBody $
-        forM (zip add_lam_x_params add_lam_y_params) $ \(x, y) ->
-          letSubExp "z" $
-            I.BasicOp $
-              I.BinOp
-                (I.Add Int64 I.OverflowUndef)
-                (I.Var $ I.paramName x)
-                (I.Var $ I.paramName y)
-  let add_lam =
-        I.Lambda
-          { I.lambdaBody = add_lam_body,
-            I.lambdaParams = add_lam_x_params ++ add_lam_y_params,
-            I.lambdaReturnType = replicate k $ I.Prim int64
-          }
-      nes = replicate (length increments) $ intConst Int64 0
-
-  scan <- I.scanSOAC [I.Scan add_lam nes]
-  all_offsets <- letTupExp "offsets" $ I.Op $ I.Screma w increments scan
-
-  -- We have the offsets for each of the partitions, but we also need
-  -- the total sizes, which are the last elements in the offests.  We
-  -- just have to be careful in case the array is empty.
-  last_index <- letSubExp "last_index" $ I.BasicOp $ I.BinOp (I.Sub Int64 OverflowUndef) w $ constant (1 :: Int64)
-  nonempty_body <- runBodyBinder $
-    fmap resultBody $
-      forM all_offsets $ \offset_array ->
-        letSubExp "last_offset" $ I.BasicOp $ I.Index offset_array [I.DimFix last_index]
-  let empty_body = resultBody $ replicate k $ constant (0 :: Int64)
-  is_empty <- letSubExp "is_empty" $ I.BasicOp $ I.CmpOp (CmpEq int64) w $ constant (0 :: Int64)
-  sizes <-
-    letTupExp "partition_size" $
-      I.If is_empty empty_body nonempty_body $
-        ifCommon $ replicate k $ I.Prim int64
-
-  -- The total size of all partitions must necessarily be equal to the
-  -- size of the input array.
-
-  -- Create scratch arrays for the result.
-  blanks <- forM arr_ts $ \arr_t ->
-    letExp "partition_dest" $
-      I.BasicOp $ Scratch (I.elemType arr_t) (w : drop 1 (I.arrayDims arr_t))
-
-  -- Now write into the result.
-  write_lam <- do
-    c_param <- I.Param <$> newVName "c" <*> pure (I.Prim int64)
-    offset_params <- replicateM k $ I.Param <$> newVName "offset" <*> pure (I.Prim int64)
-    value_params <- forM arr_ts $ \arr_t ->
-      I.Param <$> newVName "v" <*> pure (I.rowType arr_t)
-    (offset, offset_stms) <-
-      collectStms $
-        mkOffsetLambdaBody
-          (map I.Var sizes)
-          (I.Var $ I.paramName c_param)
-          0
-          offset_params
-    return
-      I.Lambda
-        { I.lambdaParams = c_param : offset_params ++ value_params,
-          I.lambdaReturnType =
-            replicate (length arr_ts) (I.Prim int64)
-              ++ map I.rowType arr_ts,
-          I.lambdaBody =
-            mkBody offset_stms $
-              replicate (length arr_ts) offset
-                ++ map (I.Var . I.paramName) value_params
-        }
-  results <-
-    letTupExp "partition_res" $
-      I.Op $
-        I.Scatter
-          w
-          write_lam
-          (classes : all_offsets ++ arrs)
-          $ zip3 (repeat $ Shape [w]) (repeat 1) blanks
-  sizes' <-
-    letSubExp "partition_sizes" $
-      I.BasicOp $
-        I.ArrayLit (map I.Var sizes) $ I.Prim int64
-  return (map I.Var results, [sizes'])
-  where
-    mkOffsetLambdaBody ::
-      [SubExp] ->
-      SubExp ->
-      Int ->
-      [I.LParam] ->
-      InternaliseM SubExp
-    mkOffsetLambdaBody _ _ _ [] =
-      return $ constant (-1 :: Int64)
-    mkOffsetLambdaBody sizes c i (p : ps) = do
-      is_this_one <-
-        letSubExp "is_this_one" $
-          I.BasicOp $
-            I.CmpOp (CmpEq int64) c $
-              intConst Int64 $ toInteger i
-      next_one <- mkOffsetLambdaBody sizes c (i + 1) ps
-      this_one <-
-        letSubExp "this_offset"
-          =<< foldBinOp
-            (Add Int64 OverflowUndef)
-            (constant (-1 :: Int64))
-            (I.Var (I.paramName p) : take i sizes)
-      letSubExp "total_res" $
-        I.If
-          is_this_one
-          (resultBody [this_one])
-          (resultBody [next_one])
-          $ ifCommon [I.Prim int64]
-
-typeExpForError :: E.TypeExp VName -> InternaliseM [ErrorMsgPart SubExp]
-typeExpForError (E.TEVar qn _) =
-  return [ErrorString $ pretty qn]
-typeExpForError (E.TEUnique te _) =
-  ("*" :) <$> typeExpForError te
-typeExpForError (E.TEArray te d _) = do
-  d' <- dimExpForError d
-  te' <- typeExpForError te
-  return $ ["[", d', "]"] ++ te'
-typeExpForError (E.TETuple tes _) = do
-  tes' <- mapM typeExpForError tes
-  return $ ["("] ++ intercalate [", "] tes' ++ [")"]
-typeExpForError (E.TERecord fields _) = do
-  fields' <- mapM onField fields
-  return $ ["{"] ++ intercalate [", "] fields' ++ ["}"]
-  where
-    onField (k, te) =
-      (ErrorString (pretty k ++ ": ") :) <$> typeExpForError te
-typeExpForError (E.TEArrow _ t1 t2 _) = do
-  t1' <- typeExpForError t1
-  t2' <- typeExpForError t2
-  return $ t1' ++ [" -> "] ++ t2'
-typeExpForError (E.TEApply t arg _) = do
-  t' <- typeExpForError t
-  arg' <- case arg of
-    TypeArgExpType argt -> typeExpForError argt
-    TypeArgExpDim d _ -> pure <$> dimExpForError d
-  return $ t' ++ [" "] ++ arg'
-typeExpForError (E.TESum cs _) = do
-  cs' <- mapM (onClause . snd) cs
-  return $ intercalate [" | "] cs'
-  where
-    onClause c = do
-      c' <- mapM typeExpForError c
-      return $ intercalate [" "] c'
-
-dimExpForError :: E.DimExp VName -> InternaliseM (ErrorMsgPart SubExp)
-dimExpForError (DimExpNamed d _) = do
-  substs <- lookupSubst $ E.qualLeaf d
-  d' <- case substs of
-    Just [v] -> return v
-    _ -> return $ I.Var $ E.qualLeaf d
-  return $ ErrorInt64 d'
-dimExpForError (DimExpConst d _) =
-  return $ ErrorString $ pretty d
-dimExpForError DimExpAny = return ""
-
--- A smart constructor that compacts neighbouring literals for easier
--- reading in the IR.
-errorMsg :: [ErrorMsgPart a] -> ErrorMsg a
-errorMsg = ErrorMsg . compact
-  where
-    compact [] = []
-    compact (ErrorString x : ErrorString y : parts) =
-      compact (ErrorString (x ++ y) : parts)
-    compact (x : y) = x : compact y
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict #-}
+
+-- |
+--
+-- This module implements a transformation from source to core
+-- Futhark.
+module Futhark.Internalise (internaliseProg) where
+
+import qualified Data.Text as T
+import Futhark.Compiler.Config
+import Futhark.IR.SOACS as I hiding (stmPattern)
+import Futhark.Internalise.Defunctionalise as Defunctionalise
+import Futhark.Internalise.Defunctorise as Defunctorise
+import qualified Futhark.Internalise.Exps as Exps
+import Futhark.Internalise.LiftLambdas as LiftLambdas
+import Futhark.Internalise.Monad as I
+import Futhark.Internalise.Monomorphise as Monomorphise
+import Futhark.Util.Log
+import Language.Futhark.Semantic (Imports)
+
+-- | Convert a program in source Futhark to a program in the Futhark
+-- core language.
+internaliseProg ::
+  (MonadFreshNames m, MonadLogger m) =>
+  FutharkConfig ->
+  Imports ->
+  m (I.Prog SOACS)
+internaliseProg config prog = do
+  maybeLog "Defunctorising"
+  prog_decs <- Defunctorise.transformProg prog
+  maybeLog "Monomorphising"
+  prog_decs' <- Monomorphise.transformProg prog_decs
+  maybeLog "Lifting lambdas"
+  prog_decs'' <- LiftLambdas.transformProg prog_decs'
+  maybeLog "Defunctionalising"
+  prog_decs''' <- Defunctionalise.transformProg prog_decs''
+  maybeLog "Converting to core IR"
+  Exps.transformProg (futharkSafe config) prog_decs'''
+  where
+    verbose = fst (futharkVerbose config) > NotVerbose
+    maybeLog s
+      | verbose = logMsg (s :: T.Text)
+      | otherwise = pure ()
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
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE Strict #-}
 
 -- | Internalising bindings.
 module Futhark.Internalise.Bindings
@@ -83,30 +84,23 @@
   where
     processFlatPattern' pat [] _ = do
       let (vs, substs) = unzip pat
-          substs' = M.fromList substs
-          idents = reverse vs
-      return (idents, substs')
+      return (reverse vs, M.fromList substs)
     processFlatPattern' pat (p : rest) ts = do
-      (ps, subst, rest_ts) <- handleMapping ts <$> internaliseBindee p
-      processFlatPattern' ((ps, (E.identName p, map (I.Var . I.paramName) subst)) : pat) rest rest_ts
+      (ps, rest_ts) <- handleMapping ts <$> internaliseBindee p
+      processFlatPattern' ((ps, (E.identName p, map (I.Var . I.paramName) ps)) : pat) rest rest_ts
 
     handleMapping ts [] =
-      ([], [], ts)
-    handleMapping ts (r : rs) =
-      let (ps, reps, ts') = handleMapping' ts r
-          (pss, repss, ts'') = handleMapping ts' rs
-       in (ps ++ pss, reps : repss, ts'')
-
-    handleMapping' (t : ts) vname =
-      let v' = I.Param vname t
-       in ([v'], v', ts)
-    handleMapping' [] _ =
-      error $ "processFlatPattern: insufficient identifiers in pattern." ++ show (x, y)
+      ([], ts)
+    handleMapping (t : ts) (r : rs) =
+      let (ps, ts') = handleMapping ts rs
+       in (I.Param r t : ps, ts')
+    handleMapping [] _ =
+      error $ "handleMapping: insufficient identifiers in pattern." ++ show (x, y)
 
     internaliseBindee :: E.Ident -> InternaliseM [VName]
     internaliseBindee bindee = do
       let name = E.identName bindee
-      n <- internalisedTypeSize $ flip E.setAliases () $ E.unInfo $ E.identType bindee
+      n <- internalisedTypeSize $ E.unInfo $ E.identType bindee
       case n of
         1 -> return [name]
         _ -> replicateM n $ newVName $ baseString name
@@ -122,8 +116,7 @@
   local (\env -> env {envSubsts = substs `M.union` envSubsts env}) $
     m ps
 
--- | Flatten a pattern.  Returns a list of identifiers.  The
--- structural type of each identifier is returned separately.
+-- | Flatten a pattern.  Returns a list of identifiers.
 flattenPattern :: MonadFreshNames m => E.Pattern -> m [E.Ident]
 flattenPattern = flattenPattern'
   where
@@ -157,6 +150,4 @@
   InternaliseM a
 stmPattern pat ts m = do
   pat' <- flattenPattern pat
-  let addShapeStms l =
-        m (map I.paramName $ concat l)
-  bindingFlatPattern pat' ts addShapeStms
+  bindingFlatPattern pat' ts $ m . map I.paramName . concat
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
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TupleSections #-}
 
 -- | Defunctionalization of typed, monomorphic Futhark programs without modules.
@@ -8,7 +8,7 @@
 
 import qualified Control.Arrow as Arrow
 import Control.Monad.Identity
-import Control.Monad.RWS hiding (Sum)
+import Control.Monad.Reader
 import Control.Monad.State
 import Data.Bifunctor
 import Data.Bitraversable
@@ -17,7 +17,6 @@
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import qualified Data.Sequence as Seq
 import qualified Data.Set as S
 import Futhark.IR.Pretty ()
 import qualified Futhark.Internalise.FreeVars as FV
@@ -203,7 +202,7 @@
 -- | Returns the defunctionalization environment restricted
 -- to the given set of variable names and types.
 restrictEnvTo :: FV.NameSet -> DefM Env
-restrictEnvTo (FV.NameSet m) = restrict <$> ask
+restrictEnvTo (FV.NameSet m) = asks restrict
   where
     restrict (globals, env) = M.mapMaybeWithKey keep env
       where
@@ -230,25 +229,29 @@
 -- the current Env as well as the set of globally defined dynamic
 -- functions.  This is used to avoid unnecessarily large closure
 -- environments.
-newtype DefM a = DefM (RWS (S.Set VName, Env) (Seq.Seq ValBind) VNameSource a)
+newtype DefM a
+  = DefM (ReaderT (S.Set VName, Env) (State ([ValBind], VNameSource)) a)
   deriving
     ( Functor,
       Applicative,
       Monad,
       MonadReader (S.Set VName, Env),
-      MonadWriter (Seq.Seq ValBind),
-      MonadFreshNames
+      MonadState ([ValBind], VNameSource)
     )
 
+instance MonadFreshNames DefM where
+  putNameSource src = modify $ \(x, _) -> (x, src)
+  getNameSource = gets snd
+
 -- | Run a computation in the defunctionalization monad. Returns the result of
 -- the computation, a new name source, and a list of lifted function declations.
-runDefM :: VNameSource -> DefM a -> (a, VNameSource, Seq.Seq ValBind)
-runDefM src (DefM m) = runRWS m mempty src
+runDefM :: VNameSource -> DefM a -> (a, VNameSource, [ValBind])
+runDefM src (DefM m) =
+  let (x, (vbs, src')) = runState (runReaderT m mempty) (mempty, src)
+   in (x, src', reverse vbs)
 
-collectFuns :: DefM a -> DefM (a, Seq.Seq ValBind)
-collectFuns m = pass $ do
-  (x, decs) <- listen m
-  return ((x, decs), const mempty)
+addValBind :: ValBind -> DefM ()
+addValBind vb = modify $ first (vb :)
 
 -- | Looks up the associated static value for a given name in the environment.
 lookupVar :: StructType -> VName -> DefM StaticVal
@@ -1011,7 +1014,7 @@
 -- | Create a new top-level value declaration with the given function name,
 -- return type, list of parameters, and body expression.
 liftValDec :: VName -> PatternType -> [VName] -> [Pattern] -> Exp -> DefM ()
-liftValDec fname rettype dims pats body = tell $ Seq.singleton dec
+liftValDec fname rettype dims pats body = addValBind dec
   where
     dims' = map (`TypeParamDim` mempty) dims
     -- FIXME: this pass is still not correctly size-preserving, so
@@ -1283,16 +1286,15 @@
     )
 
 -- | Defunctionalize a list of top-level declarations.
-defuncVals :: [ValBind] -> DefM (Seq.Seq ValBind)
-defuncVals [] = return mempty
+defuncVals :: [ValBind] -> DefM ()
+defuncVals [] = pure ()
 defuncVals (valbind : ds) = do
-  ((valbind', env, dyn), defs) <- collectFuns $ defuncValBind valbind
-  ds' <-
-    localEnv env $
-      if dyn
-        then isGlobal (valBindName valbind') $ defuncVals ds
-        else defuncVals ds
-  return $ defs <> Seq.singleton valbind' <> ds'
+  (valbind', env, dyn) <- defuncValBind valbind
+  addValBind valbind'
+  localEnv env $
+    if dyn
+      then isGlobal (valBindName valbind') $ defuncVals ds
+      else defuncVals ds
 
 {-# NOINLINE transformProg #-}
 
@@ -1301,5 +1303,5 @@
 -- resulting list of declarations.
 transformProg :: MonadFreshNames m => [ValBind] -> m [ValBind]
 transformProg decs = modifyNameSource $ \namesrc ->
-  let (decs', namesrc', liftedDecs) = runDefM namesrc $ defuncVals decs
-   in (toList $ liftedDecs <> decs', namesrc')
+  let ((), namesrc', decs') = runDefM namesrc $ defuncVals decs
+   in (decs', namesrc')
diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs
new file mode 100644
--- /dev/null
+++ b/src/Futhark/Internalise/Exps.hs
@@ -0,0 +1,2126 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Futhark.Internalise.Exps (transformProg) where
+
+import Control.Monad.Reader
+import Data.List (find, intercalate, intersperse, transpose)
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import Futhark.IR.SOACS as I hiding (stmPattern)
+import Futhark.Internalise.AccurateSizes
+import Futhark.Internalise.Bindings
+import Futhark.Internalise.Lambdas
+import Futhark.Internalise.Monad as I
+import Futhark.Internalise.TypesValues
+import Futhark.Transform.Rename as I
+import Futhark.Util (splitAt3)
+import Futhark.Util.Pretty (prettyOneLine)
+import Language.Futhark as E hiding (TypeArg)
+
+-- | Convert a program in source Futhark to a program in the Futhark
+-- core language.
+transformProg :: MonadFreshNames m => Bool -> [E.ValBind] -> m (I.Prog SOACS)
+transformProg always_safe vbinds = do
+  (consts, funs) <-
+    runInternaliseM always_safe (internaliseValBinds vbinds)
+  I.renameProg $ I.Prog consts funs
+
+internaliseAttr :: E.AttrInfo -> Attr
+internaliseAttr (E.AttrAtom v) = I.AttrAtom v
+internaliseAttr (E.AttrComp f attrs) = I.AttrComp f $ map internaliseAttr attrs
+
+internaliseAttrs :: [E.AttrInfo] -> Attrs
+internaliseAttrs = mconcat . map (oneAttr . internaliseAttr)
+
+internaliseValBinds :: [E.ValBind] -> InternaliseM ()
+internaliseValBinds = mapM_ internaliseValBind
+
+internaliseFunName :: VName -> Name
+internaliseFunName = nameFromString . pretty
+
+internaliseValBind :: E.ValBind -> InternaliseM ()
+internaliseValBind fb@(E.ValBind entry fname retdecl (Info (rettype, _)) tparams params body _ attrs loc) = do
+  localConstsScope $
+    bindingFParams tparams params $ \shapeparams params' -> do
+      let shapenames = map I.paramName shapeparams
+
+      msg <- case retdecl of
+        Just dt ->
+          errorMsg
+            . ("Function return value does not match shape of type " :)
+            <$> typeExpForError dt
+        Nothing -> return $ errorMsg ["Function return value does not match shape of declared return type."]
+
+      (body', rettype') <- buildBody $ do
+        body_res <- internaliseExp (baseString fname <> "_res") body
+        rettype_bad <-
+          internaliseReturnType rettype =<< mapM subExpType body_res
+        let rettype' = zeroExts rettype_bad
+        body_res' <-
+          ensureResultExtShape msg loc (map I.fromDecl rettype') body_res
+        pure (body_res', rettype')
+
+      let all_params = shapeparams ++ concat params'
+
+      let fd =
+            I.FunDef
+              Nothing
+              (internaliseAttrs attrs)
+              (internaliseFunName fname)
+              rettype'
+              all_params
+              body'
+
+      if null params'
+        then bindConstant fname fd
+        else
+          bindFunction
+            fname
+            fd
+            ( shapenames,
+              map declTypeOf $ concat params',
+              all_params,
+              applyRetType rettype' all_params
+            )
+
+  case entry of
+    Just (Info entry') -> generateEntryPoint entry' fb
+    Nothing -> return ()
+  where
+    zeroExts ts = generaliseExtTypes ts ts
+
+generateEntryPoint :: E.EntryPoint -> E.ValBind -> InternaliseM ()
+generateEntryPoint (E.EntryPoint e_paramts e_rettype) vb = localConstsScope $ do
+  let (E.ValBind _ ofname _ (Info (rettype, _)) tparams params _ _ attrs loc) = vb
+  bindingFParams tparams params $ \shapeparams params' -> do
+    entry_rettype <- internaliseEntryReturnType rettype
+    let entry' = entryPoint (baseName ofname) (zip e_paramts params') (e_rettype, entry_rettype)
+        args = map (I.Var . I.paramName) $ concat params'
+
+    entry_body <- buildBody_ $ do
+      -- Special case the (rare) situation where the entry point is
+      -- not a function.
+      maybe_const <- lookupConst ofname
+      vals <- case maybe_const of
+        Just ses ->
+          return ses
+        Nothing ->
+          fst <$> funcall "entry_result" (E.qualName ofname) args loc
+      ctx <-
+        extractShapeContext (concat entry_rettype)
+          <$> mapM (fmap I.arrayDims . subExpType) vals
+      pure $ ctx ++ vals
+
+    addFunDef $
+      I.FunDef
+        (Just entry')
+        (internaliseAttrs attrs)
+        ("entry_" <> baseName ofname)
+        (concat entry_rettype)
+        (shapeparams ++ concat params')
+        entry_body
+
+entryPoint ::
+  Name ->
+  [(E.EntryType, [I.FParam])] ->
+  ( E.EntryType,
+    [[I.TypeBase ExtShape Uniqueness]]
+  ) ->
+  I.EntryPoint
+entryPoint name params (eret, crets) =
+  ( name,
+    concatMap (entryPointType . preParam) params,
+    case ( isTupleRecord $ entryType eret,
+           entryAscribed eret
+         ) of
+      (Just ts, Just (E.TETuple e_ts _)) ->
+        concatMap entryPointType $
+          zip (zipWith E.EntryType ts (map Just e_ts)) crets
+      (Just ts, Nothing) ->
+        concatMap entryPointType $
+          zip (map (`E.EntryType` Nothing) ts) crets
+      _ ->
+        entryPointType (eret, concat crets)
+  )
+  where
+    preParam (e_t, ps) = (e_t, staticShapes $ map I.paramDeclType ps)
+
+    entryPointType (t, ts)
+      | E.Scalar (E.Prim E.Unsigned {}) <- E.entryType t =
+        [I.TypeUnsigned]
+      | E.Array _ _ (E.Prim E.Unsigned {}) _ <- E.entryType t =
+        [I.TypeUnsigned]
+      | E.Scalar E.Prim {} <- E.entryType t =
+        [I.TypeDirect]
+      | E.Array _ _ E.Prim {} _ <- E.entryType t =
+        [I.TypeDirect]
+      | otherwise =
+        [I.TypeOpaque desc $ length ts]
+      where
+        desc = maybe (prettyOneLine t') typeExpOpaqueName $ E.entryAscribed t
+        t' = noSizes (E.entryType t) `E.setUniqueness` Nonunique
+    typeExpOpaqueName (TEApply te TypeArgExpDim {} _) =
+      typeExpOpaqueName te
+    typeExpOpaqueName (TEArray te _ _) =
+      let (d, te') = withoutDims te
+       in "arr_" ++ typeExpOpaqueName te'
+            ++ "_"
+            ++ show (1 + d)
+            ++ "d"
+    typeExpOpaqueName te = prettyOneLine te
+
+    withoutDims (TEArray te _ _) =
+      let (d, te') = withoutDims te
+       in (d + 1, te')
+    withoutDims te = (0 :: Int, te)
+
+internaliseBody :: String -> E.Exp -> InternaliseM Body
+internaliseBody desc e =
+  buildBody_ $ internaliseExp (desc <> "_res") e
+
+bodyFromStms ::
+  InternaliseM (Result, a) ->
+  InternaliseM (Body, a)
+bodyFromStms m = do
+  ((res, a), stms) <- collectStms m
+  (,a) <$> mkBodyM stms res
+
+internaliseAppExp :: String -> E.AppExp -> InternaliseM [I.SubExp]
+internaliseAppExp desc (E.Index e idxs loc) = do
+  vs <- internaliseExpToVars "indexed" e
+  dims <- case vs of
+    [] -> return [] -- Will this happen?
+    v : _ -> I.arrayDims <$> lookupType v
+  (idxs', cs) <- internaliseSlice loc dims idxs
+  let index v = do
+        v_t <- lookupType v
+        return $ I.BasicOp $ I.Index v $ fullSlice v_t idxs'
+  certifying cs $ letSubExps desc =<< mapM index vs
+internaliseAppExp desc (E.Range start maybe_second end loc) = do
+  start' <- internaliseExp1 "range_start" start
+  end' <- internaliseExp1 "range_end" $ case end of
+    DownToExclusive e -> e
+    ToInclusive e -> e
+    UpToExclusive e -> e
+  maybe_second' <-
+    traverse (internaliseExp1 "range_second") maybe_second
+
+  -- Construct an error message in case the range is invalid.
+  let conv = case E.typeOf start of
+        E.Scalar (E.Prim (E.Unsigned _)) -> asIntZ Int64
+        _ -> asIntS Int64
+  start'_i64 <- conv start'
+  end'_i64 <- conv end'
+  maybe_second'_i64 <- traverse conv maybe_second'
+  let errmsg =
+        errorMsg $
+          ["Range "]
+            ++ [ErrorInt64 start'_i64]
+            ++ ( case maybe_second'_i64 of
+                   Nothing -> []
+                   Just second_i64 -> ["..", ErrorInt64 second_i64]
+               )
+            ++ ( case end of
+                   DownToExclusive {} -> ["..>"]
+                   ToInclusive {} -> ["..."]
+                   UpToExclusive {} -> ["..<"]
+               )
+            ++ [ErrorInt64 end'_i64, " is invalid."]
+
+  (it, le_op, lt_op) <-
+    case E.typeOf start of
+      E.Scalar (E.Prim (E.Signed it)) -> return (it, CmpSle it, CmpSlt it)
+      E.Scalar (E.Prim (E.Unsigned it)) -> return (it, CmpUle it, CmpUlt it)
+      start_t -> error $ "Start value in range has type " ++ pretty start_t
+
+  let one = intConst it 1
+      negone = intConst it (-1)
+      default_step = case end of
+        DownToExclusive {} -> negone
+        ToInclusive {} -> one
+        UpToExclusive {} -> one
+
+  (step, step_zero) <- case maybe_second' of
+    Just second' -> do
+      subtracted_step <-
+        letSubExp "subtracted_step" $
+          I.BasicOp $ I.BinOp (I.Sub it I.OverflowWrap) second' start'
+      step_zero <- letSubExp "step_zero" $ I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) start' second'
+      return (subtracted_step, step_zero)
+    Nothing ->
+      return (default_step, constant False)
+
+  step_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum it) step
+  step_sign_i64 <- asIntS Int64 step_sign
+
+  bounds_invalid_downwards <-
+    letSubExp "bounds_invalid_downwards" $
+      I.BasicOp $ I.CmpOp le_op start' end'
+  bounds_invalid_upwards <-
+    letSubExp "bounds_invalid_upwards" $
+      I.BasicOp $ I.CmpOp lt_op end' start'
+
+  (distance, step_wrong_dir, bounds_invalid) <- case end of
+    DownToExclusive {} -> do
+      step_wrong_dir <-
+        letSubExp "step_wrong_dir" $
+          I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign one
+      distance <-
+        letSubExp "distance" $
+          I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) start' end'
+      distance_i64 <- asIntS Int64 distance
+      return (distance_i64, step_wrong_dir, bounds_invalid_downwards)
+    UpToExclusive {} -> do
+      step_wrong_dir <-
+        letSubExp "step_wrong_dir" $
+          I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign negone
+      distance <- letSubExp "distance" $ I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) end' start'
+      distance_i64 <- asIntS Int64 distance
+      return (distance_i64, step_wrong_dir, bounds_invalid_upwards)
+    ToInclusive {} -> do
+      downwards <-
+        letSubExp "downwards" $
+          I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign negone
+      distance_downwards_exclusive <-
+        letSubExp "distance_downwards_exclusive" $
+          I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) start' end'
+      distance_upwards_exclusive <-
+        letSubExp "distance_upwards_exclusive" $
+          I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) end' start'
+
+      bounds_invalid <-
+        letSubExp "bounds_invalid" $
+          I.If
+            downwards
+            (resultBody [bounds_invalid_downwards])
+            (resultBody [bounds_invalid_upwards])
+            $ ifCommon [I.Prim I.Bool]
+      distance_exclusive <-
+        letSubExp "distance_exclusive" $
+          I.If
+            downwards
+            (resultBody [distance_downwards_exclusive])
+            (resultBody [distance_upwards_exclusive])
+            $ ifCommon [I.Prim $ IntType it]
+      distance_exclusive_i64 <- asIntS Int64 distance_exclusive
+      distance <-
+        letSubExp "distance" $
+          I.BasicOp $
+            I.BinOp
+              (Add Int64 I.OverflowWrap)
+              distance_exclusive_i64
+              (intConst Int64 1)
+      return (distance, constant False, bounds_invalid)
+
+  step_invalid <-
+    letSubExp "step_invalid" $
+      I.BasicOp $ I.BinOp I.LogOr step_wrong_dir step_zero
+
+  invalid <-
+    letSubExp "range_invalid" $
+      I.BasicOp $ I.BinOp I.LogOr step_invalid bounds_invalid
+  valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp I.Not invalid
+  cs <- assert "range_valid_c" valid errmsg loc
+
+  step_i64 <- asIntS Int64 step
+  pos_step <-
+    letSubExp "pos_step" $
+      I.BasicOp $ I.BinOp (Mul Int64 I.OverflowWrap) step_i64 step_sign_i64
+
+  num_elems <-
+    certifying cs $
+      letSubExp "num_elems" $
+        I.BasicOp $ I.BinOp (SDivUp Int64 I.Unsafe) distance pos_step
+
+  se <- letSubExp desc (I.BasicOp $ I.Iota num_elems start' step it)
+  return [se]
+internaliseAppExp desc (E.Coerce e (TypeDecl dt (Info et)) loc) = do
+  ses <- internaliseExp desc e
+  ts <- internaliseReturnType et =<< mapM subExpType ses
+  dt' <- typeExpForError dt
+  forM (zip ses ts) $ \(e', t') -> do
+    dims <- arrayDims <$> subExpType e'
+    let parts =
+          ["Value of (core language) shape ("]
+            ++ intersperse ", " (map ErrorInt64 dims)
+            ++ [") cannot match shape of type `"]
+            ++ dt'
+            ++ ["`."]
+    ensureExtShape (errorMsg parts) loc (I.fromDecl t') desc e'
+internaliseAppExp desc e@E.Apply {} = do
+  (qfname, args) <- findFuncall e
+
+  -- Argument evaluation is outermost-in so that any existential sizes
+  -- created by function applications can be brought into scope.
+  let fname = nameFromString $ pretty $ baseName $ qualLeaf qfname
+      loc = srclocOf e
+      arg_desc = nameToString fname ++ "_arg"
+
+  -- Some functions are magical (overloaded) and we handle that here.
+  case () of
+    -- Overloaded functions never take array arguments (except
+    -- equality, but those cannot be existential), so we can safely
+    -- ignore the existential dimensions.
+    ()
+      | Just internalise <- isOverloadedFunction qfname (map fst args) loc ->
+        internalise desc
+      | baseTag (qualLeaf qfname) <= maxIntrinsicTag,
+        Just (rettype, _) <- M.lookup fname I.builtInFunctions -> do
+        let tag ses = [(se, I.Observe) | se <- ses]
+        args' <- reverse <$> mapM (internaliseArg arg_desc) (reverse args)
+        let args'' = concatMap tag args'
+        letTupExp' desc $
+          I.Apply
+            fname
+            args''
+            [I.Prim rettype]
+            (Safe, loc, [])
+      | otherwise -> do
+        args' <- concat . reverse <$> mapM (internaliseArg arg_desc) (reverse args)
+        fst <$> funcall desc qfname args' loc
+internaliseAppExp desc (E.LetPat sizes pat e body _) =
+  internalisePat desc sizes pat e body (internaliseExp desc)
+internaliseAppExp _ (E.LetFun ofname _ _ _) =
+  error $ "Unexpected LetFun " ++ pretty ofname
+internaliseAppExp desc (E.DoLoop sparams mergepat mergeexp form loopbody loc) = do
+  ses <- internaliseExp "loop_init" mergeexp
+  ((loopbody', (form', shapepat, mergepat', mergeinit')), initstms) <-
+    collectStms $ handleForm ses form
+
+  addStms initstms
+  mergeinit_ts' <- mapM subExpType mergeinit'
+
+  ctxinit <- argShapes (map I.paramName shapepat) mergepat' mergeinit_ts'
+
+  let ctxmerge = zip shapepat ctxinit
+      valmerge = zip mergepat' mergeinit'
+      dropCond = case form of
+        E.While {} -> drop 1
+        _ -> id
+
+  -- Ensure that the result of the loop matches the shapes of the
+  -- merge parameters.  XXX: Ideally they should already match (by
+  -- the source language type rules), but some of our
+  -- transformations (esp. defunctionalisation) strips out some size
+  -- information.  For a type-correct source program, these reshapes
+  -- should simplify away.
+  let merge = ctxmerge ++ valmerge
+      merge_ts = map (I.paramType . fst) merge
+  loopbody'' <-
+    localScope (scopeOfFParams $ map fst merge) . inScopeOf form' . buildBody_ $
+      ensureArgShapes
+        "shape of loop result does not match shapes in loop parameter"
+        loc
+        (map (I.paramName . fst) ctxmerge)
+        merge_ts
+        =<< bodyBind loopbody'
+
+  attrs <- asks envAttrs
+  map I.Var . dropCond
+    <$> attributing
+      attrs
+      (letTupExp desc (I.DoLoop ctxmerge valmerge form' loopbody''))
+  where
+    sparams' = map (`TypeParamDim` mempty) sparams
+
+    forLoop mergepat' shapepat mergeinit form' =
+      bodyFromStms $
+        inScopeOf form' $ do
+          ses <- internaliseExp "loopres" loopbody
+          sets <- mapM subExpType ses
+          shapeargs <- argShapes (map I.paramName shapepat) mergepat' sets
+          return
+            ( shapeargs ++ ses,
+              ( form',
+                shapepat,
+                mergepat',
+                mergeinit
+              )
+            )
+
+    handleForm mergeinit (E.ForIn x arr) = do
+      arr' <- internaliseExpToVars "for_in_arr" arr
+      arr_ts <- mapM lookupType arr'
+      let w = arraysSize 0 arr_ts
+
+      i <- newVName "i"
+
+      ts <- mapM subExpType mergeinit
+      bindingLoopParams sparams' mergepat ts $
+        \shapepat mergepat' ->
+          bindingLambdaParams [x] (map rowType arr_ts) $ \x_params -> do
+            let loopvars = zip x_params arr'
+            forLoop mergepat' shapepat mergeinit $
+              I.ForLoop i Int64 w loopvars
+    handleForm mergeinit (E.For i num_iterations) = do
+      num_iterations' <- internaliseExp1 "upper_bound" num_iterations
+      num_iterations_t <- I.subExpType num_iterations'
+      it <- case num_iterations_t of
+        I.Prim (IntType it) -> return it
+        _ -> error "internaliseExp DoLoop: invalid type"
+
+      ts <- mapM subExpType mergeinit
+      bindingLoopParams sparams' mergepat ts $
+        \shapepat mergepat' ->
+          forLoop mergepat' shapepat mergeinit $
+            I.ForLoop (E.identName i) it num_iterations' []
+    handleForm mergeinit (E.While cond) = do
+      ts <- mapM subExpType mergeinit
+      bindingLoopParams sparams' mergepat ts $ \shapepat mergepat' -> do
+        mergeinit_ts <- mapM subExpType mergeinit
+        -- We need to insert 'cond' twice - once for the initial
+        -- condition (do we enter the loop at all?), and once with the
+        -- result values of the loop (do we continue into the next
+        -- iteration?).  This is safe, as the type rules for the
+        -- external language guarantees that 'cond' does not consume
+        -- anything.
+        shapeinit <- argShapes (map I.paramName shapepat) mergepat' mergeinit_ts
+
+        (loop_initial_cond, init_loop_cond_bnds) <- collectStms $ do
+          forM_ (zip shapepat shapeinit) $ \(p, se) ->
+            letBindNames [paramName p] $ BasicOp $ SubExp se
+          forM_ (zip mergepat' mergeinit) $ \(p, se) ->
+            unless (se == I.Var (paramName p)) $
+              letBindNames [paramName p] $
+                BasicOp $
+                  case se of
+                    I.Var v
+                      | not $ primType $ paramType p ->
+                        Reshape (map DimCoercion $ arrayDims $ paramType p) v
+                    _ -> SubExp se
+          internaliseExp1 "loop_cond" cond
+
+        addStms init_loop_cond_bnds
+
+        bodyFromStms $ do
+          ses <- internaliseExp "loopres" loopbody
+          sets <- mapM subExpType ses
+          loop_while <- newParam "loop_while" $ I.Prim I.Bool
+          shapeargs <- argShapes (map I.paramName shapepat) mergepat' sets
+
+          -- Careful not to clobber anything.
+          loop_end_cond_body <- renameBody <=< buildBody_ $ do
+            forM_ (zip shapepat shapeargs) $ \(p, se) ->
+              unless (se == I.Var (paramName p)) $
+                letBindNames [paramName p] $ BasicOp $ SubExp se
+            forM_ (zip mergepat' ses) $ \(p, se) ->
+              unless (se == I.Var (paramName p)) $
+                letBindNames [paramName p] $
+                  BasicOp $
+                    case se of
+                      I.Var v
+                        | not $ primType $ paramType p ->
+                          Reshape (map DimCoercion $ arrayDims $ paramType p) v
+                      _ -> SubExp se
+            internaliseExp "loop_cond" cond
+          loop_end_cond <- bodyBind loop_end_cond_body
+
+          return
+            ( shapeargs ++ loop_end_cond ++ ses,
+              ( I.WhileLoop $ I.paramName loop_while,
+                shapepat,
+                loop_while : mergepat',
+                loop_initial_cond : mergeinit
+              )
+            )
+internaliseAppExp desc (E.LetWith name src idxs ve body loc) = do
+  let pat = E.Id (E.identName name) (E.identType name) loc
+      src_t = E.fromStruct <$> E.identType src
+      e = E.Update (E.Var (E.qualName $ E.identName src) src_t loc) idxs ve loc
+  internaliseExp desc $
+    E.AppExp
+      (E.LetPat [] pat e body loc)
+      (Info (AppRes (E.typeOf body) mempty))
+internaliseAppExp desc (E.Match e cs _) = do
+  ses <- internaliseExp (desc ++ "_scrutinee") e
+  case NE.uncons cs of
+    (CasePat pCase eCase _, Nothing) -> do
+      (_, pertinent) <- generateCond pCase ses
+      internalisePat' [] pCase pertinent eCase (internaliseExp desc)
+    (c, Just cs') -> do
+      let CasePat pLast eLast _ = NE.last cs'
+      bFalse <- do
+        (_, pertinent) <- generateCond pLast ses
+        eLast' <- internalisePat' [] pLast pertinent eLast (internaliseBody desc)
+        foldM (\bf c' -> eBody $ return $ generateCaseIf ses c' bf) eLast' $
+          reverse $ NE.init cs'
+      letTupExp' desc =<< generateCaseIf ses c bFalse
+internaliseAppExp desc (E.If ce te fe _) =
+  letTupExp' desc
+    =<< eIf
+      (BasicOp . SubExp <$> internaliseExp1 "cond" ce)
+      (internaliseBody (desc <> "_t") te)
+      (internaliseBody (desc <> "_f") fe)
+internaliseAppExp _ e@E.BinOp {} =
+  error $ "internaliseAppExp: Unexpected BinOp " ++ pretty e
+
+internaliseExp :: String -> E.Exp -> InternaliseM [I.SubExp]
+internaliseExp desc (E.Parens e _) =
+  internaliseExp desc e
+internaliseExp desc (E.QualParens _ e _) =
+  internaliseExp desc e
+internaliseExp desc (E.StringLit vs _) =
+  fmap pure $
+    letSubExp desc $
+      I.BasicOp $ I.ArrayLit (map constant vs) $ I.Prim int8
+internaliseExp _ (E.Var (E.QualName _ name) _ _) = do
+  subst <- lookupSubst name
+  case subst of
+    Just substs -> return substs
+    Nothing -> pure [I.Var name]
+internaliseExp desc (E.AppExp e (Info appres)) = do
+  ses <- internaliseAppExp desc e
+  bindExtSizes appres ses
+  pure ses
+
+-- XXX: we map empty records and tuples to units, because otherwise
+-- arrays of unit will lose their sizes.
+internaliseExp _ (E.TupLit [] _) =
+  return [constant UnitValue]
+internaliseExp _ (E.RecordLit [] _) =
+  return [constant UnitValue]
+internaliseExp desc (E.TupLit es _) = concat <$> mapM (internaliseExp desc) es
+internaliseExp desc (E.RecordLit orig_fields _) =
+  concatMap snd . sortFields . M.unions <$> mapM internaliseField orig_fields
+  where
+    internaliseField (E.RecordFieldExplicit name e _) =
+      M.singleton name <$> internaliseExp desc e
+    internaliseField (E.RecordFieldImplicit name t loc) =
+      internaliseField $
+        E.RecordFieldExplicit
+          (baseName name)
+          (E.Var (E.qualName name) t loc)
+          loc
+internaliseExp desc (E.ArrayLit es (Info arr_t) loc)
+  -- If this is a multidimensional array literal of primitives, we
+  -- treat it specially by flattening it out followed by a reshape.
+  -- This cuts down on the amount of statements that are produced, and
+  -- thus allows us to efficiently handle huge array literals - a
+  -- corner case, but an important one.
+  | Just ((eshape, e') : es') <- mapM isArrayLiteral es,
+    not $ null eshape,
+    all ((eshape ==) . fst) es',
+    Just basetype <- E.peelArray (length eshape) arr_t = do
+    let flat_lit = E.ArrayLit (e' ++ concatMap snd es') (Info basetype) loc
+        new_shape = length es : eshape
+    flat_arrs <- internaliseExpToVars "flat_literal" flat_lit
+    forM flat_arrs $ \flat_arr -> do
+      flat_arr_t <- lookupType flat_arr
+      let new_shape' =
+            reshapeOuter
+              (map (DimNew . intConst Int64 . toInteger) new_shape)
+              1
+              $ I.arrayShape flat_arr_t
+      letSubExp desc $ I.BasicOp $ I.Reshape new_shape' flat_arr
+  | otherwise = do
+    es' <- mapM (internaliseExp "arr_elem") es
+    arr_t_ext <- internaliseType $ E.toStruct arr_t
+
+    rowtypes <-
+      case mapM (fmap rowType . hasStaticShape . I.fromDecl) arr_t_ext of
+        Just ts -> pure ts
+        Nothing ->
+          -- XXX: the monomorphiser may create single-element array
+          -- literals with an unknown row type.  In those cases we
+          -- need to look at the types of the actual elements.
+          -- Fixing this in the monomorphiser is a lot more tricky
+          -- than just working around it here.
+          case es' of
+            [] -> error $ "internaliseExp ArrayLit: existential type: " ++ pretty arr_t
+            e' : _ -> mapM subExpType e'
+
+    let arraylit ks rt = do
+          ks' <-
+            mapM
+              ( ensureShape
+                  "shape of element differs from shape of first element"
+                  loc
+                  rt
+                  "elem_reshaped"
+              )
+              ks
+          return $ I.BasicOp $ I.ArrayLit ks' rt
+
+    letSubExps desc
+      =<< if null es'
+        then mapM (arraylit []) rowtypes
+        else zipWithM arraylit (transpose es') rowtypes
+  where
+    isArrayLiteral :: E.Exp -> Maybe ([Int], [E.Exp])
+    isArrayLiteral (E.ArrayLit inner_es _ _) = do
+      (eshape, e) : inner_es' <- mapM isArrayLiteral inner_es
+      guard $ all ((eshape ==) . fst) inner_es'
+      return (length inner_es : eshape, e ++ concatMap snd inner_es')
+    isArrayLiteral e =
+      Just ([], [e])
+internaliseExp desc (E.Ascript e _ _) =
+  internaliseExp desc e
+internaliseExp desc (E.Negate e _) = do
+  e' <- internaliseExp1 "negate_arg" e
+  et <- subExpType e'
+  case et of
+    I.Prim (I.IntType t) ->
+      letTupExp' desc $ I.BasicOp $ I.BinOp (I.Sub t I.OverflowWrap) (I.intConst t 0) e'
+    I.Prim (I.FloatType t) ->
+      letTupExp' desc $ I.BasicOp $ I.BinOp (I.FSub t) (I.floatConst t 0) e'
+    _ -> error "Futhark.Internalise.internaliseExp: non-numeric type in Negate"
+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 slice
+
+  let comb sname ve' = do
+        sname_t <- lookupType sname
+        let full_slice = fullSlice sname_t idxs'
+            rowtype = sname_t `setArrayDims` sliceDims full_slice
+        ve'' <-
+          ensureShape
+            "shape of value does not match shape of source array"
+            loc
+            rowtype
+            "lw_val_correct_shape"
+            ve'
+        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
+  ve' <- internaliseExp desc ve
+  replace (E.typeOf src `setAliases` ()) fields ve' src'
+  where
+    replace (E.Scalar (E.Record m)) (f : fs) ve' src'
+      | Just t <- M.lookup f m = do
+        i <-
+          fmap sum $
+            mapM (internalisedTypeSize . snd) $
+              takeWhile ((/= f) . fst) $ sortFields m
+        k <- internalisedTypeSize t
+        let (bef, to_update, aft) = splitAt3 i k src'
+        src'' <- replace t fs ve' to_update
+        return $ bef ++ src'' ++ aft
+    replace _ _ ve' _ = return ve'
+internaliseExp desc (E.Attr attr e _) =
+  local f $ internaliseExp desc e
+  where
+    attrs = oneAttr $ internaliseAttr attr
+    f env
+      | "unsafe" `inAttrs` attrs,
+        not $ envSafe env =
+        env {envDoBoundsChecks = False}
+      | otherwise =
+        env {envAttrs = envAttrs env <> attrs}
+internaliseExp desc (E.Assert e1 e2 (Info check) loc) = do
+  e1' <- internaliseExp1 "assert_cond" e1
+  c <- assert "assert_c" e1' (errorMsg [ErrorString $ "Assertion is false: " <> check]) loc
+  -- Make sure there are some bindings to certify.
+  certifying c $ mapM rebind =<< internaliseExp desc e2
+  where
+    rebind v = do
+      v' <- newVName "assert_res"
+      letBindNames [v'] $ I.BasicOp $ I.SubExp v
+      return $ I.Var v'
+internaliseExp _ (E.Constr c es (Info (E.Scalar (E.Sum fs))) _) = do
+  (ts, constr_map) <- internaliseSumType $ M.map (map E.toStruct) fs
+  es' <- concat <$> mapM (internaliseExp "payload") es
+
+  let noExt _ = return $ intConst Int64 0
+  ts' <- instantiateShapes noExt $ map fromDecl ts
+
+  case M.lookup c constr_map of
+    Just (i, js) ->
+      (intConst Int8 (toInteger i) :) <$> clauses 0 ts' (zip js es')
+    Nothing ->
+      error "internaliseExp Constr: missing constructor"
+  where
+    clauses j (t : ts) js_to_es
+      | Just e <- j `lookup` js_to_es =
+        (e :) <$> clauses (j + 1) ts js_to_es
+      | otherwise = do
+        blank <- letSubExp "zero" =<< eBlank t
+        (blank :) <$> clauses (j + 1) ts js_to_es
+    clauses _ [] _ =
+      return []
+internaliseExp _ (E.Constr _ _ (Info t) loc) =
+  error $ "internaliseExp: constructor with type " ++ pretty t ++ " at " ++ locStr loc
+-- The "interesting" cases are over, now it's mostly boilerplate.
+
+internaliseExp _ (E.Literal v _) =
+  return [I.Constant $ internalisePrimValue v]
+internaliseExp _ (E.IntLit v (Info t) _) =
+  case t of
+    E.Scalar (E.Prim (E.Signed it)) ->
+      return [I.Constant $ I.IntValue $ intValue it v]
+    E.Scalar (E.Prim (E.Unsigned it)) ->
+      return [I.Constant $ I.IntValue $ intValue it v]
+    E.Scalar (E.Prim (E.FloatType ft)) ->
+      return [I.Constant $ I.FloatValue $ floatValue ft v]
+    _ -> error $ "internaliseExp: nonsensical type for integer literal: " ++ pretty t
+internaliseExp _ (E.FloatLit v (Info t) _) =
+  case t of
+    E.Scalar (E.Prim (E.FloatType ft)) ->
+      return [I.Constant $ I.FloatValue $ floatValue ft v]
+    _ -> error $ "internaliseExp: nonsensical type for float literal: " ++ pretty t
+-- Builtin operators are handled specially because they are
+-- overloaded.
+internaliseExp desc (E.Project k e (Info rt) _) = do
+  n <- internalisedTypeSize $ rt `setAliases` ()
+  i' <- fmap sum $
+    mapM internalisedTypeSize $
+      case E.typeOf e `setAliases` () of
+        E.Scalar (Record fs) ->
+          map snd $ takeWhile ((/= k) . fst) $ sortFields fs
+        t -> [t]
+  take n . drop i' <$> internaliseExp desc e
+internaliseExp _ e@E.Lambda {} =
+  error $ "internaliseExp: Unexpected lambda at " ++ locStr (srclocOf e)
+internaliseExp _ e@E.OpSection {} =
+  error $ "internaliseExp: Unexpected operator section at " ++ locStr (srclocOf e)
+internaliseExp _ e@E.OpSectionLeft {} =
+  error $ "internaliseExp: Unexpected left operator section at " ++ locStr (srclocOf e)
+internaliseExp _ e@E.OpSectionRight {} =
+  error $ "internaliseExp: Unexpected right operator section at " ++ locStr (srclocOf e)
+internaliseExp _ e@E.ProjectSection {} =
+  error $ "internaliseExp: Unexpected projection section at " ++ locStr (srclocOf e)
+internaliseExp _ e@E.IndexSection {} =
+  error $ "internaliseExp: Unexpected index section at " ++ locStr (srclocOf e)
+
+internaliseArg :: String -> (E.Exp, Maybe VName) -> InternaliseM [SubExp]
+internaliseArg desc (arg, argdim) = do
+  arg' <- internaliseExp desc arg
+  case (arg', argdim) of
+    ([se], Just d) -> letBindNames [d] $ BasicOp $ SubExp se
+    _ -> return ()
+  return arg'
+
+subExpPrimType :: I.SubExp -> InternaliseM I.PrimType
+subExpPrimType = fmap I.elemType . subExpType
+
+generateCond :: E.Pattern -> [I.SubExp] -> InternaliseM (I.SubExp, [I.SubExp])
+generateCond orig_p orig_ses = do
+  (cmps, pertinent, _) <- compares orig_p orig_ses
+  cmp <- letSubExp "matches" =<< eAll cmps
+  return (cmp, pertinent)
+  where
+    -- Literals are always primitive values.
+    compares (E.PatternLit l t _) (se : ses) = do
+      e' <- case l of
+        PatLitPrim v -> pure $ constant $ internalisePrimValue v
+        PatLitInt x -> internaliseExp1 "constant" $ E.IntLit x t mempty
+        PatLitFloat x -> internaliseExp1 "constant" $ E.FloatLit x t mempty
+      t' <- subExpPrimType se
+      cmp <- letSubExp "match_lit" $ I.BasicOp $ I.CmpOp (I.CmpEq t') e' se
+      return ([cmp], [se], ses)
+    compares (E.PatternConstr c (Info (E.Scalar (E.Sum fs))) pats _) (se : ses) = do
+      (payload_ts, m) <- internaliseSumType $ M.map (map toStruct) fs
+      case M.lookup c m of
+        Just (i, payload_is) -> do
+          let i' = intConst Int8 $ toInteger i
+          let (payload_ses, ses') = splitAt (length payload_ts) ses
+          cmp <- letSubExp "match_constr" $ I.BasicOp $ I.CmpOp (I.CmpEq int8) i' se
+          (cmps, pertinent, _) <- comparesMany pats $ map (payload_ses !!) payload_is
+          return (cmp : cmps, pertinent, ses')
+        Nothing ->
+          error "generateCond: missing constructor"
+    compares (E.PatternConstr _ (Info t) _ _) _ =
+      error $ "generateCond: PatternConstr has nonsensical type: " ++ pretty t
+    compares (E.Id _ t loc) ses =
+      compares (E.Wildcard t loc) ses
+    compares (E.Wildcard (Info t) _) ses = do
+      n <- internalisedTypeSize $ E.toStruct t
+      let (id_ses, rest_ses) = splitAt n ses
+      return ([], id_ses, rest_ses)
+    compares (E.PatternParens pat _) ses =
+      compares pat ses
+    -- XXX: treat empty tuples and records as bool.
+    compares (E.TuplePattern [] loc) ses =
+      compares (E.Wildcard (Info $ E.Scalar $ E.Prim E.Bool) loc) ses
+    compares (E.RecordPattern [] loc) ses =
+      compares (E.Wildcard (Info $ E.Scalar $ E.Prim E.Bool) loc) ses
+    compares (E.TuplePattern pats _) ses =
+      comparesMany pats ses
+    compares (E.RecordPattern fs _) ses =
+      comparesMany (map snd $ E.sortFields $ M.fromList fs) ses
+    compares (E.PatternAscription pat _ _) ses =
+      compares pat ses
+    compares pat [] =
+      error $ "generateCond: No values left for pattern " ++ pretty pat
+
+    comparesMany [] ses = return ([], [], ses)
+    comparesMany (pat : pats) ses = do
+      (cmps1, pertinent1, ses') <- compares pat ses
+      (cmps2, pertinent2, ses'') <- comparesMany pats ses'
+      return
+        ( cmps1 <> cmps2,
+          pertinent1 <> pertinent2,
+          ses''
+        )
+
+generateCaseIf :: [I.SubExp] -> Case -> I.Body -> InternaliseM I.Exp
+generateCaseIf ses (CasePat p eCase _) bFail = do
+  (cond, pertinent) <- generateCond p ses
+  eCase' <- internalisePat' [] p pertinent eCase (internaliseBody "case")
+  eIf (eSubExp cond) (return eCase') (return bFail)
+
+internalisePat ::
+  String ->
+  [E.SizeBinder VName] ->
+  E.Pattern ->
+  E.Exp ->
+  E.Exp ->
+  (E.Exp -> InternaliseM a) ->
+  InternaliseM a
+internalisePat desc sizes p e body m = do
+  ses <- internaliseExp desc' e
+  internalisePat' sizes p ses body m
+  where
+    desc' = case S.toList $ E.patternIdents p of
+      [v] -> baseString $ E.identName v
+      _ -> desc
+
+internalisePat' ::
+  [E.SizeBinder VName] ->
+  E.Pattern ->
+  [I.SubExp] ->
+  E.Exp ->
+  (E.Exp -> InternaliseM a) ->
+  InternaliseM a
+internalisePat' sizes p ses body m = do
+  ses_ts <- mapM subExpType ses
+  stmPattern p ses_ts $ \pat_names -> do
+    bindExtSizes (AppRes (E.patternType p) (map E.sizeName sizes)) ses
+    forM_ (zip pat_names ses) $ \(v, se) ->
+      letBindNames [v] $ I.BasicOp $ I.SubExp se
+    m body
+
+internaliseSlice ::
+  SrcLoc ->
+  [SubExp] ->
+  [E.DimIndex] ->
+  InternaliseM ([I.DimIndex SubExp], Certificates)
+internaliseSlice loc dims idxs = do
+  (idxs', oks, parts) <- unzip3 <$> zipWithM internaliseDimIndex dims idxs
+  ok <- letSubExp "index_ok" =<< eAll oks
+  let msg =
+        errorMsg $
+          ["Index ["] ++ intercalate [", "] parts
+            ++ ["] out of bounds for array of shape ["]
+            ++ intersperse "][" (map ErrorInt64 $ take (length idxs) dims)
+            ++ ["]."]
+  c <- assert "index_certs" ok msg loc
+  return (idxs', c)
+
+internaliseDimIndex ::
+  SubExp ->
+  E.DimIndex ->
+  InternaliseM (I.DimIndex SubExp, SubExp, [ErrorMsgPart SubExp])
+internaliseDimIndex w (E.DimFix i) = do
+  (i', _) <- internaliseDimExp "i" i
+  let lowerBound =
+        I.BasicOp $
+          I.CmpOp (I.CmpSle I.Int64) (I.constant (0 :: I.Int64)) i'
+      upperBound =
+        I.BasicOp $
+          I.CmpOp (I.CmpSlt I.Int64) i' w
+  ok <- letSubExp "bounds_check" =<< eBinOp I.LogAnd (pure lowerBound) (pure upperBound)
+  return (I.DimFix i', ok, [ErrorInt64 i'])
+
+-- Special-case an important common case that otherwise leads to horrible code.
+internaliseDimIndex
+  w
+  ( E.DimSlice
+      Nothing
+      Nothing
+      (Just (E.Negate (E.IntLit 1 _ _) _))
+    ) = do
+    w_minus_1 <-
+      letSubExp "w_minus_1" $
+        BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) w one
+    return
+      ( I.DimSlice w_minus_1 w $ intConst Int64 (-1),
+        constant True,
+        mempty
+      )
+    where
+      one = constant (1 :: Int64)
+internaliseDimIndex w (E.DimSlice i j s) = do
+  s' <- maybe (return one) (fmap fst . internaliseDimExp "s") s
+  s_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum Int64) s'
+  backwards <- letSubExp "backwards" $ I.BasicOp $ I.CmpOp (I.CmpEq int64) s_sign negone
+  w_minus_1 <- letSubExp "w_minus_1" $ BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) w one
+  let i_def =
+        letSubExp "i_def" $
+          I.If
+            backwards
+            (resultBody [w_minus_1])
+            (resultBody [zero])
+            $ ifCommon [I.Prim int64]
+      j_def =
+        letSubExp "j_def" $
+          I.If
+            backwards
+            (resultBody [negone])
+            (resultBody [w])
+            $ ifCommon [I.Prim int64]
+  i' <- maybe i_def (fmap fst . internaliseDimExp "i") i
+  j' <- maybe j_def (fmap fst . internaliseDimExp "j") j
+  j_m_i <- letSubExp "j_m_i" $ BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) j' i'
+  -- Something like a division-rounding-up, but accomodating negative
+  -- operands.
+  let divRounding x y =
+        eBinOp
+          (SQuot Int64 Safe)
+          ( eBinOp
+              (Add Int64 I.OverflowWrap)
+              x
+              (eBinOp (Sub Int64 I.OverflowWrap) y (eSignum $ toExp s'))
+          )
+          y
+  n <- letSubExp "n" =<< divRounding (toExp j_m_i) (toExp s')
+
+  zero_stride <- letSubExp "zero_stride" $ I.BasicOp $ I.CmpOp (CmpEq int64) s_sign zero
+  nonzero_stride <- letSubExp "nonzero_stride" $ I.BasicOp $ I.UnOp Not zero_stride
+
+  -- Bounds checks depend on whether we are slicing forwards or
+  -- backwards.  If forwards, we must check '0 <= i && i <= j'.  If
+  -- backwards, '-1 <= j && j <= i'.  In both cases, we check '0 <=
+  -- i+n*s && i+(n-1)*s < w'.  We only check if the slice is nonempty.
+  empty_slice <- letSubExp "empty_slice" $ I.BasicOp $ I.CmpOp (CmpEq int64) n zero
+
+  m <- letSubExp "m" $ I.BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) n one
+  m_t_s <- letSubExp "m_t_s" $ I.BasicOp $ I.BinOp (Mul Int64 I.OverflowWrap) m s'
+  i_p_m_t_s <- letSubExp "i_p_m_t_s" $ I.BasicOp $ I.BinOp (Add Int64 I.OverflowWrap) i' m_t_s
+  zero_leq_i_p_m_t_s <-
+    letSubExp "zero_leq_i_p_m_t_s" $
+      I.BasicOp $ I.CmpOp (I.CmpSle Int64) zero i_p_m_t_s
+  i_p_m_t_s_leq_w <-
+    letSubExp "i_p_m_t_s_leq_w" $
+      I.BasicOp $ I.CmpOp (I.CmpSle Int64) i_p_m_t_s w
+  i_p_m_t_s_lth_w <-
+    letSubExp "i_p_m_t_s_leq_w" $
+      I.BasicOp $ I.CmpOp (I.CmpSlt Int64) i_p_m_t_s w
+
+  zero_lte_i <- letSubExp "zero_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) zero i'
+  i_lte_j <- letSubExp "i_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) i' j'
+  forwards_ok <-
+    letSubExp "forwards_ok"
+      =<< eAll [zero_lte_i, zero_lte_i, i_lte_j, zero_leq_i_p_m_t_s, i_p_m_t_s_lth_w]
+
+  negone_lte_j <- letSubExp "negone_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) negone j'
+  j_lte_i <- letSubExp "j_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) j' i'
+  backwards_ok <-
+    letSubExp "backwards_ok"
+      =<< eAll
+        [negone_lte_j, negone_lte_j, j_lte_i, zero_leq_i_p_m_t_s, i_p_m_t_s_leq_w]
+
+  slice_ok <-
+    letSubExp "slice_ok" $
+      I.If
+        backwards
+        (resultBody [backwards_ok])
+        (resultBody [forwards_ok])
+        $ ifCommon [I.Prim I.Bool]
+
+  ok_or_empty <-
+    letSubExp "ok_or_empty" $
+      I.BasicOp $ I.BinOp I.LogOr empty_slice slice_ok
+
+  acceptable <-
+    letSubExp "slice_acceptable" $
+      I.BasicOp $ I.BinOp I.LogAnd nonzero_stride ok_or_empty
+
+  let parts = case (i, j, s) of
+        (_, _, Just {}) ->
+          [ maybe "" (const $ ErrorInt64 i') i,
+            ":",
+            maybe "" (const $ ErrorInt64 j') j,
+            ":",
+            ErrorInt64 s'
+          ]
+        (_, Just {}, _) ->
+          [ maybe "" (const $ ErrorInt64 i') i,
+            ":",
+            ErrorInt64 j'
+          ]
+            ++ maybe mempty (const [":", ErrorInt64 s']) s
+        (_, Nothing, Nothing) ->
+          [ErrorInt64 i', ":"]
+  return (I.DimSlice i' n s', acceptable, parts)
+  where
+    zero = constant (0 :: Int64)
+    negone = constant (-1 :: Int64)
+    one = constant (1 :: Int64)
+
+internaliseScanOrReduce ::
+  String ->
+  String ->
+  (SubExp -> I.Lambda -> [SubExp] -> [VName] -> InternaliseM (SOAC SOACS)) ->
+  (E.Exp, E.Exp, E.Exp, SrcLoc) ->
+  InternaliseM [SubExp]
+internaliseScanOrReduce desc what f (lam, ne, arr, loc) = do
+  arrs <- internaliseExpToVars (what ++ "_arr") arr
+  nes <- internaliseExp (what ++ "_ne") ne
+  nes' <- forM (zip nes arrs) $ \(ne', arr') -> do
+    rowtype <- I.stripArray 1 <$> lookupType arr'
+    ensureShape
+      "Row shape of input array does not match shape of neutral element"
+      loc
+      rowtype
+      (what ++ "_ne_right_shape")
+      ne'
+  nests <- mapM I.subExpType nes'
+  arrts <- mapM lookupType arrs
+  lam' <- internaliseFoldLambda internaliseLambda lam nests arrts
+  w <- arraysSize 0 <$> mapM lookupType arrs
+  letTupExp' desc . I.Op =<< f w lam' nes' arrs
+
+internaliseHist ::
+  String ->
+  E.Exp ->
+  E.Exp ->
+  E.Exp ->
+  E.Exp ->
+  E.Exp ->
+  E.Exp ->
+  SrcLoc ->
+  InternaliseM [SubExp]
+internaliseHist desc rf hist op ne buckets img loc = do
+  rf' <- internaliseExp1 "hist_rf" rf
+  ne' <- internaliseExp "hist_ne" ne
+  hist' <- internaliseExpToVars "hist_hist" hist
+  buckets' <-
+    letExp "hist_buckets" . BasicOp . SubExp
+      =<< internaliseExp1 "hist_buckets" buckets
+  img' <- internaliseExpToVars "hist_img" img
+
+  -- reshape neutral element to have same size as the destination array
+  ne_shp <- forM (zip ne' hist') $ \(n, h) -> do
+    rowtype <- I.stripArray 1 <$> lookupType h
+    ensureShape
+      "Row shape of destination array does not match shape of neutral element"
+      loc
+      rowtype
+      "hist_ne_right_shape"
+      n
+  ne_ts <- mapM I.subExpType ne_shp
+  his_ts <- mapM lookupType hist'
+  op' <- internaliseFoldLambda internaliseLambda op ne_ts his_ts
+
+  -- reshape return type of bucket function to have same size as neutral element
+  -- (modulo the index)
+  bucket_param <- newParam "bucket_p" $ I.Prim int64
+  img_params <- mapM (newParam "img_p" . rowType) =<< mapM lookupType img'
+  let params = bucket_param : img_params
+      rettype = I.Prim int64 : ne_ts
+      body = mkBody mempty $ map (I.Var . paramName) params
+  lam' <-
+    mkLambda params $
+      ensureResultShape
+        "Row shape of value array does not match row shape of hist target"
+        (srclocOf img)
+        rettype
+        =<< bodyBind body
+
+  -- get sizes of histogram and image arrays
+  w_hist <- arraysSize 0 <$> mapM lookupType hist'
+  w_img <- arraysSize 0 <$> mapM lookupType img'
+
+  -- Generate an assertion and reshapes to ensure that buckets' and
+  -- img' are the same size.
+  b_shape <- I.arrayShape <$> lookupType buckets'
+  let b_w = shapeSize 0 b_shape
+  cmp <- letSubExp "bucket_cmp" $ I.BasicOp $ I.CmpOp (I.CmpEq I.int64) b_w w_img
+  c <-
+    assert
+      "bucket_cert"
+      cmp
+      "length of index and value array does not match"
+      loc
+  buckets'' <-
+    certifying c $
+      letExp (baseString buckets') $
+        I.BasicOp $ I.Reshape (reshapeOuter [DimCoercion w_img] 1 b_shape) buckets'
+
+  letTupExp' desc . I.Op $
+    I.Hist w_img [HistOp w_hist rf' hist' ne_shp op'] lam' $ buckets'' : img'
+
+internaliseStreamMap ::
+  String ->
+  StreamOrd ->
+  E.Exp ->
+  E.Exp ->
+  InternaliseM [SubExp]
+internaliseStreamMap desc o lam arr = do
+  arrs <- internaliseExpToVars "stream_input" arr
+  lam' <- internaliseStreamMapLambda internaliseLambda lam $ map I.Var arrs
+  w <- arraysSize 0 <$> mapM lookupType arrs
+  let form = I.Parallel o Commutative (I.Lambda [] (mkBody mempty []) [])
+  letTupExp' desc $ I.Op $ I.Stream w arrs form [] lam'
+
+internaliseStreamRed ::
+  String ->
+  StreamOrd ->
+  Commutativity ->
+  E.Exp ->
+  E.Exp ->
+  E.Exp ->
+  InternaliseM [SubExp]
+internaliseStreamRed desc o comm lam0 lam arr = do
+  arrs <- internaliseExpToVars "stream_input" arr
+  rowts <- mapM (fmap I.rowType . lookupType) arrs
+  (lam_params, lam_body) <-
+    internaliseStreamLambda internaliseLambda lam rowts
+  let (chunk_param, _, lam_val_params) =
+        partitionChunkedFoldParameters 0 lam_params
+
+  -- Synthesize neutral elements by applying the fold function
+  -- to an empty chunk.
+  letBindNames [I.paramName chunk_param] $
+    I.BasicOp $ I.SubExp $ constant (0 :: Int64)
+  forM_ lam_val_params $ \p ->
+    letBindNames [I.paramName p] $
+      I.BasicOp $
+        I.Scratch (I.elemType $ I.paramType p) $
+          I.arrayDims $ I.paramType p
+  nes <- bodyBind =<< renameBody lam_body
+
+  nes_ts <- mapM I.subExpType nes
+  outsz <- arraysSize 0 <$> mapM lookupType arrs
+  let acc_arr_tps = [I.arrayOf t (I.Shape [outsz]) NoUniqueness | t <- nes_ts]
+  lam0' <- internaliseFoldLambda internaliseLambda lam0 nes_ts acc_arr_tps
+
+  let lam0_acc_params = take (length nes) $ I.lambdaParams lam0'
+  lam_acc_params <- forM lam0_acc_params $ \p -> do
+    name <- newVName $ baseString $ I.paramName p
+    return p {I.paramName = name}
+
+  -- Make sure the chunk size parameter comes first.
+  let lam_params' = chunk_param : lam_acc_params ++ lam_val_params
+
+  lam' <- mkLambda lam_params' $ do
+    lam_res <- bodyBind lam_body
+    lam_res' <-
+      ensureArgShapes
+        "shape of chunk function result does not match shape of initial value"
+        (srclocOf lam)
+        []
+        (map I.typeOf $ I.lambdaParams lam0')
+        lam_res
+    ensureResultShape
+      "shape of result does not match shape of initial value"
+      (srclocOf lam0)
+      nes_ts
+      =<< ( eLambda lam0' . map eSubExp $
+              map (I.Var . paramName) lam_acc_params ++ lam_res'
+          )
+
+  let form = I.Parallel o comm lam0'
+  w <- arraysSize 0 <$> mapM lookupType arrs
+  letTupExp' desc $ I.Op $ I.Stream w arrs form nes lam'
+
+internaliseStreamAcc ::
+  String ->
+  E.Exp ->
+  Maybe (E.Exp, E.Exp) ->
+  E.Exp ->
+  E.Exp ->
+  InternaliseM [SubExp]
+internaliseStreamAcc desc dest op lam bs = do
+  dest' <- internaliseExpToVars "scatter_dest" dest
+  bs' <- internaliseExpToVars "scatter_input" bs
+
+  acc_cert_v <- newVName "acc_cert"
+  dest_ts <- mapM lookupType dest'
+  let dest_w = arraysSize 0 dest_ts
+      acc_t = Acc acc_cert_v (Shape [dest_w]) (map rowType dest_ts) NoUniqueness
+  acc_p <- newParam "acc_p" acc_t
+  withacc_lam <- mkLambda [Param acc_cert_v (I.Prim I.Unit), acc_p] $ do
+    lam' <-
+      internaliseMapLambda internaliseLambda lam $
+        map I.Var $ paramName acc_p : bs'
+    w <- arraysSize 0 <$> mapM lookupType bs'
+    letTupExp' "acc_res" $ I.Op $ I.Screma w (paramName acc_p : bs') (I.mapSOAC lam')
+
+  op' <-
+    case op of
+      Just (op_lam, ne) -> do
+        ne' <- internaliseExp "hist_ne" ne
+        ne_ts <- mapM I.subExpType ne'
+        (lam_params, lam_body, lam_rettype) <-
+          internaliseLambda op_lam $ ne_ts ++ ne_ts
+        idxp <- newParam "idx" $ I.Prim int64
+        let op_lam' = I.Lambda (idxp : lam_params) lam_body lam_rettype
+        return $ Just (op_lam', ne')
+      Nothing ->
+        return Nothing
+
+  destw <- arraysSize 0 <$> mapM lookupType dest'
+  fmap (map I.Var) $
+    letTupExp desc $ WithAcc [(Shape [destw], dest', op')] withacc_lam
+
+internaliseExp1 :: String -> E.Exp -> InternaliseM I.SubExp
+internaliseExp1 desc e = do
+  vs <- internaliseExp desc e
+  case vs of
+    [se] -> return se
+    _ -> error "Internalise.internaliseExp1: was passed not just a single subexpression"
+
+-- | Promote to dimension type as appropriate for the original type.
+-- Also return original type.
+internaliseDimExp :: String -> E.Exp -> InternaliseM (I.SubExp, IntType)
+internaliseDimExp s e = do
+  e' <- internaliseExp1 s e
+  case E.typeOf e of
+    E.Scalar (E.Prim (Signed it)) -> (,it) <$> asIntS Int64 e'
+    _ -> error "internaliseDimExp: bad type"
+
+internaliseExpToVars :: String -> E.Exp -> InternaliseM [I.VName]
+internaliseExpToVars desc e =
+  mapM asIdent =<< internaliseExp desc e
+  where
+    asIdent (I.Var v) = return v
+    asIdent se = letExp desc $ I.BasicOp $ I.SubExp se
+
+internaliseOperation ::
+  String ->
+  E.Exp ->
+  (I.VName -> InternaliseM I.BasicOp) ->
+  InternaliseM [I.SubExp]
+internaliseOperation s e op = do
+  vs <- internaliseExpToVars s e
+  letSubExps s =<< mapM (fmap I.BasicOp . op) vs
+
+certifyingNonzero ::
+  SrcLoc ->
+  IntType ->
+  SubExp ->
+  InternaliseM a ->
+  InternaliseM a
+certifyingNonzero loc t x m = do
+  zero <-
+    letSubExp "zero" $
+      I.BasicOp $
+        CmpOp (CmpEq (IntType t)) x (intConst t 0)
+  nonzero <- letSubExp "nonzero" $ I.BasicOp $ UnOp Not zero
+  c <- assert "nonzero_cert" nonzero "division by zero" loc
+  certifying c m
+
+certifyingNonnegative ::
+  SrcLoc ->
+  IntType ->
+  SubExp ->
+  InternaliseM a ->
+  InternaliseM a
+certifyingNonnegative loc t x m = do
+  nonnegative <-
+    letSubExp "nonnegative" $
+      I.BasicOp $
+        CmpOp (CmpSle t) (intConst t 0) x
+  c <- assert "nonzero_cert" nonnegative "negative exponent" loc
+  certifying c m
+
+internaliseBinOp ::
+  SrcLoc ->
+  String ->
+  E.BinOp ->
+  I.SubExp ->
+  I.SubExp ->
+  E.PrimType ->
+  E.PrimType ->
+  InternaliseM [I.SubExp]
+internaliseBinOp _ desc E.Plus x y (E.Signed t) _ =
+  simpleBinOp desc (I.Add t I.OverflowWrap) x y
+internaliseBinOp _ desc E.Plus x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Add t I.OverflowWrap) x y
+internaliseBinOp _ desc E.Plus x y (E.FloatType t) _ =
+  simpleBinOp desc (I.FAdd t) x y
+internaliseBinOp _ desc E.Minus x y (E.Signed t) _ =
+  simpleBinOp desc (I.Sub t I.OverflowWrap) x y
+internaliseBinOp _ desc E.Minus x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Sub t I.OverflowWrap) x y
+internaliseBinOp _ desc E.Minus x y (E.FloatType t) _ =
+  simpleBinOp desc (I.FSub t) x y
+internaliseBinOp _ desc E.Times x y (E.Signed t) _ =
+  simpleBinOp desc (I.Mul t I.OverflowWrap) x y
+internaliseBinOp _ desc E.Times x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Mul t I.OverflowWrap) x y
+internaliseBinOp _ desc E.Times x y (E.FloatType t) _ =
+  simpleBinOp desc (I.FMul t) x y
+internaliseBinOp loc desc E.Divide x y (E.Signed t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.SDiv t I.Unsafe) x y
+internaliseBinOp loc desc E.Divide x y (E.Unsigned t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.UDiv t I.Unsafe) x y
+internaliseBinOp _ desc E.Divide x y (E.FloatType t) _ =
+  simpleBinOp desc (I.FDiv t) x y
+internaliseBinOp _ desc E.Pow x y (E.FloatType t) _ =
+  simpleBinOp desc (I.FPow t) x y
+internaliseBinOp loc desc E.Pow x y (E.Signed t) _ =
+  certifyingNonnegative loc t y $
+    simpleBinOp desc (I.Pow t) x y
+internaliseBinOp _ desc E.Pow x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Pow t) x y
+internaliseBinOp loc desc E.Mod x y (E.Signed t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.SMod t I.Unsafe) x y
+internaliseBinOp loc desc E.Mod x y (E.Unsigned t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.UMod t I.Unsafe) x y
+internaliseBinOp _ desc E.Mod x y (E.FloatType t) _ =
+  simpleBinOp desc (I.FMod t) x y
+internaliseBinOp loc desc E.Quot x y (E.Signed t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.SQuot t I.Unsafe) x y
+internaliseBinOp loc desc E.Quot x y (E.Unsigned t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.UDiv t I.Unsafe) x y
+internaliseBinOp loc desc E.Rem x y (E.Signed t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.SRem t I.Unsafe) x y
+internaliseBinOp loc desc E.Rem x y (E.Unsigned t) _ =
+  certifyingNonzero loc t y $
+    simpleBinOp desc (I.UMod t I.Unsafe) x y
+internaliseBinOp _ desc E.ShiftR x y (E.Signed t) _ =
+  simpleBinOp desc (I.AShr t) x y
+internaliseBinOp _ desc E.ShiftR x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.LShr t) x y
+internaliseBinOp _ desc E.ShiftL x y (E.Signed t) _ =
+  simpleBinOp desc (I.Shl t) x y
+internaliseBinOp _ desc E.ShiftL x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Shl t) x y
+internaliseBinOp _ desc E.Band x y (E.Signed t) _ =
+  simpleBinOp desc (I.And t) x y
+internaliseBinOp _ desc E.Band x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.And t) x y
+internaliseBinOp _ desc E.Xor x y (E.Signed t) _ =
+  simpleBinOp desc (I.Xor t) x y
+internaliseBinOp _ desc E.Xor x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Xor t) x y
+internaliseBinOp _ desc E.Bor x y (E.Signed t) _ =
+  simpleBinOp desc (I.Or t) x y
+internaliseBinOp _ desc E.Bor x y (E.Unsigned t) _ =
+  simpleBinOp desc (I.Or t) x y
+internaliseBinOp _ desc E.Equal x y t _ =
+  simpleCmpOp desc (I.CmpEq $ internalisePrimType t) x y
+internaliseBinOp _ desc E.NotEqual x y t _ = do
+  eq <- letSubExp (desc ++ "true") $ I.BasicOp $ I.CmpOp (I.CmpEq $ internalisePrimType t) x y
+  fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp I.Not eq
+internaliseBinOp _ desc E.Less x y (E.Signed t) _ =
+  simpleCmpOp desc (I.CmpSlt t) x y
+internaliseBinOp _ desc E.Less x y (E.Unsigned t) _ =
+  simpleCmpOp desc (I.CmpUlt t) x y
+internaliseBinOp _ desc E.Leq x y (E.Signed t) _ =
+  simpleCmpOp desc (I.CmpSle t) x y
+internaliseBinOp _ desc E.Leq x y (E.Unsigned t) _ =
+  simpleCmpOp desc (I.CmpUle t) x y
+internaliseBinOp _ desc E.Greater x y (E.Signed t) _ =
+  simpleCmpOp desc (I.CmpSlt t) y x -- Note the swapped x and y
+internaliseBinOp _ desc E.Greater x y (E.Unsigned t) _ =
+  simpleCmpOp desc (I.CmpUlt t) y x -- Note the swapped x and y
+internaliseBinOp _ desc E.Geq x y (E.Signed t) _ =
+  simpleCmpOp desc (I.CmpSle t) y x -- Note the swapped x and y
+internaliseBinOp _ desc E.Geq x y (E.Unsigned t) _ =
+  simpleCmpOp desc (I.CmpUle t) y x -- Note the swapped x and y
+internaliseBinOp _ desc E.Less x y (E.FloatType t) _ =
+  simpleCmpOp desc (I.FCmpLt t) x y
+internaliseBinOp _ desc E.Leq x y (E.FloatType t) _ =
+  simpleCmpOp desc (I.FCmpLe t) x y
+internaliseBinOp _ desc E.Greater x y (E.FloatType t) _ =
+  simpleCmpOp desc (I.FCmpLt t) y x -- Note the swapped x and y
+internaliseBinOp _ desc E.Geq x y (E.FloatType t) _ =
+  simpleCmpOp desc (I.FCmpLe t) y x -- Note the swapped x and y
+
+-- Relational operators for booleans.
+internaliseBinOp _ desc E.Less x y E.Bool _ =
+  simpleCmpOp desc I.CmpLlt x y
+internaliseBinOp _ desc E.Leq x y E.Bool _ =
+  simpleCmpOp desc I.CmpLle x y
+internaliseBinOp _ desc E.Greater x y E.Bool _ =
+  simpleCmpOp desc I.CmpLlt y x -- Note the swapped x and y
+internaliseBinOp _ desc E.Geq x y E.Bool _ =
+  simpleCmpOp desc I.CmpLle y x -- Note the swapped x and y
+internaliseBinOp _ _ op _ _ t1 t2 =
+  error $
+    "Invalid binary operator " ++ pretty op
+      ++ " with operand types "
+      ++ pretty t1
+      ++ ", "
+      ++ pretty t2
+
+simpleBinOp ::
+  String ->
+  I.BinOp ->
+  I.SubExp ->
+  I.SubExp ->
+  InternaliseM [I.SubExp]
+simpleBinOp desc bop x y =
+  letTupExp' desc $ I.BasicOp $ I.BinOp bop x y
+
+simpleCmpOp ::
+  String ->
+  I.CmpOp ->
+  I.SubExp ->
+  I.SubExp ->
+  InternaliseM [I.SubExp]
+simpleCmpOp desc op x y =
+  letTupExp' desc $ I.BasicOp $ I.CmpOp op x y
+
+findFuncall ::
+  E.AppExp ->
+  InternaliseM
+    ( E.QualName VName,
+      [(E.Exp, Maybe VName)]
+    )
+findFuncall (E.Apply f arg (Info (_, argext)) _)
+  | E.AppExp f_e _ <- f = do
+    (fname, args) <- findFuncall f_e
+    return (fname, args ++ [(arg, argext)])
+  | E.Var fname _ _ <- f =
+    return (fname, [(arg, argext)])
+findFuncall e =
+  error $ "Invalid function expression in application: " ++ pretty e
+
+-- The type of a body.  Watch out: this only works for the degenerate
+-- case where the body does not already return its context.
+bodyExtType :: Body -> InternaliseM [ExtType]
+bodyExtType (Body _ stms res) =
+  existentialiseExtTypes (M.keys stmsscope) . staticShapes
+    <$> extendedScope (traverse subExpType res) stmsscope
+  where
+    stmsscope = scopeOf stms
+
+internaliseLambda :: InternaliseLambda
+internaliseLambda (E.Parens e _) rowtypes =
+  internaliseLambda e rowtypes
+internaliseLambda (E.Lambda params body _ (Info (_, rettype)) _) rowtypes =
+  bindingLambdaParams params rowtypes $ \params' -> do
+    body' <- internaliseBody "lam" body
+    rettype' <- internaliseLambdaReturnType rettype =<< bodyExtType body'
+    return (params', body', rettype')
+internaliseLambda e _ = error $ "internaliseLambda: unexpected expression:\n" ++ pretty e
+
+-- | Some operators and functions are overloaded or otherwise special
+-- - we detect and treat them here.
+isOverloadedFunction ::
+  E.QualName VName ->
+  [E.Exp] ->
+  SrcLoc ->
+  Maybe (String -> InternaliseM [SubExp])
+isOverloadedFunction qname args loc = do
+  guard $ baseTag (qualLeaf qname) <= maxIntrinsicTag
+  let handlers =
+        [ handleSign,
+          handleIntrinsicOps,
+          handleOps,
+          handleSOACs,
+          handleAccs,
+          handleRest
+        ]
+  msum [h args $ baseString $ qualLeaf qname | h <- handlers]
+  where
+    handleSign [x] "sign_i8" = Just $ toSigned I.Int8 x
+    handleSign [x] "sign_i16" = Just $ toSigned I.Int16 x
+    handleSign [x] "sign_i32" = Just $ toSigned I.Int32 x
+    handleSign [x] "sign_i64" = Just $ toSigned I.Int64 x
+    handleSign [x] "unsign_i8" = Just $ toUnsigned I.Int8 x
+    handleSign [x] "unsign_i16" = Just $ toUnsigned I.Int16 x
+    handleSign [x] "unsign_i32" = Just $ toUnsigned I.Int32 x
+    handleSign [x] "unsign_i64" = Just $ toUnsigned I.Int64 x
+    handleSign _ _ = Nothing
+
+    handleIntrinsicOps [x] s
+      | Just unop <- find ((== s) . pretty) allUnOps = Just $ \desc -> do
+        x' <- internaliseExp1 "x" x
+        fmap pure $ letSubExp desc $ I.BasicOp $ I.UnOp unop x'
+    handleIntrinsicOps [TupLit [x, y] _] s
+      | Just bop <- find ((== s) . pretty) allBinOps = Just $ \desc -> do
+        x' <- internaliseExp1 "x" x
+        y' <- internaliseExp1 "y" y
+        fmap pure $ letSubExp desc $ I.BasicOp $ I.BinOp bop x' y'
+      | Just cmp <- find ((== s) . pretty) allCmpOps = Just $ \desc -> do
+        x' <- internaliseExp1 "x" x
+        y' <- internaliseExp1 "y" y
+        fmap pure $ letSubExp desc $ I.BasicOp $ I.CmpOp cmp x' y'
+    handleIntrinsicOps [x] s
+      | Just conv <- find ((== s) . pretty) allConvOps = Just $ \desc -> do
+        x' <- internaliseExp1 "x" x
+        fmap pure $ letSubExp desc $ I.BasicOp $ I.ConvOp conv x'
+    handleIntrinsicOps _ _ = Nothing
+
+    -- Short-circuiting operators are magical.
+    handleOps [x, y] "&&" = Just $ \desc ->
+      internaliseExp desc $
+        E.AppExp
+          (E.If x y (E.Literal (E.BoolValue False) mempty) mempty)
+          (Info $ AppRes (E.Scalar $ E.Prim E.Bool) [])
+    handleOps [x, y] "||" = Just $ \desc ->
+      internaliseExp desc $
+        E.AppExp
+          (E.If x (E.Literal (E.BoolValue True) mempty) y mempty)
+          (Info $ AppRes (E.Scalar $ E.Prim E.Bool) [])
+    -- Handle equality and inequality specially, to treat the case of
+    -- arrays.
+    handleOps [xe, ye] op
+      | Just cmp_f <- isEqlOp op = Just $ \desc -> do
+        xe' <- internaliseExp "x" xe
+        ye' <- internaliseExp "y" ye
+        rs <- zipWithM (doComparison desc) xe' ye'
+        cmp_f desc =<< letSubExp "eq" =<< eAll rs
+      where
+        isEqlOp "!=" = Just $ \desc eq ->
+          letTupExp' desc $ I.BasicOp $ I.UnOp I.Not eq
+        isEqlOp "==" = Just $ \_ eq ->
+          return [eq]
+        isEqlOp _ = Nothing
+
+        doComparison desc x y = do
+          x_t <- I.subExpType x
+          y_t <- I.subExpType y
+          case x_t of
+            I.Prim t -> letSubExp desc $ I.BasicOp $ I.CmpOp (I.CmpEq t) x y
+            _ -> do
+              let x_dims = I.arrayDims x_t
+                  y_dims = I.arrayDims y_t
+              dims_match <- forM (zip x_dims y_dims) $ \(x_dim, y_dim) ->
+                letSubExp "dim_eq" $ I.BasicOp $ I.CmpOp (I.CmpEq int64) x_dim y_dim
+              shapes_match <- letSubExp "shapes_match" =<< eAll dims_match
+              compare_elems_body <- runBodyBinder $ do
+                -- Flatten both x and y.
+                x_num_elems <-
+                  letSubExp "x_num_elems"
+                    =<< foldBinOp (I.Mul Int64 I.OverflowUndef) (constant (1 :: Int64)) x_dims
+                x' <- letExp "x" $ I.BasicOp $ I.SubExp x
+                y' <- letExp "x" $ I.BasicOp $ I.SubExp y
+                x_flat <- letExp "x_flat" $ I.BasicOp $ I.Reshape [I.DimNew x_num_elems] x'
+                y_flat <- letExp "y_flat" $ I.BasicOp $ I.Reshape [I.DimNew x_num_elems] y'
+
+                -- Compare the elements.
+                cmp_lam <- cmpOpLambda $ I.CmpEq (elemType x_t)
+                cmps <-
+                  letExp "cmps" $
+                    I.Op $
+                      I.Screma x_num_elems [x_flat, y_flat] (I.mapSOAC cmp_lam)
+
+                -- Check that all were equal.
+                and_lam <- binOpLambda I.LogAnd I.Bool
+                reduce <- I.reduceSOAC [Reduce Commutative and_lam [constant True]]
+                all_equal <- letSubExp "all_equal" $ I.Op $ I.Screma x_num_elems [cmps] reduce
+                return $ resultBody [all_equal]
+
+              letSubExp "arrays_equal" $
+                I.If shapes_match compare_elems_body (resultBody [constant False]) $
+                  ifCommon [I.Prim I.Bool]
+    handleOps [x, y] name
+      | Just bop <- find ((name ==) . pretty) [minBound .. maxBound :: E.BinOp] =
+        Just $ \desc -> do
+          x' <- internaliseExp1 "x" x
+          y' <- internaliseExp1 "y" y
+          case (E.typeOf x, E.typeOf y) of
+            (E.Scalar (E.Prim t1), E.Scalar (E.Prim t2)) ->
+              internaliseBinOp loc desc bop x' y' t1 t2
+            _ -> error "Futhark.Internalise.internaliseExp: non-primitive type in BinOp."
+    handleOps _ _ = Nothing
+
+    handleSOACs [TupLit [lam, arr] _] "map" = Just $ \desc -> do
+      arr' <- internaliseExpToVars "map_arr" arr
+      lam' <- internaliseMapLambda internaliseLambda lam $ map I.Var arr'
+      w <- arraysSize 0 <$> mapM lookupType arr'
+      letTupExp' desc $
+        I.Op $
+          I.Screma w arr' (I.mapSOAC lam')
+    handleSOACs [TupLit [k, lam, arr] _] "partition" = do
+      k' <- fromIntegral <$> fromInt32 k
+      Just $ \_desc -> do
+        arrs <- internaliseExpToVars "partition_input" arr
+        lam' <- internalisePartitionLambda internaliseLambda k' lam $ map I.Var arrs
+        uncurry (++) <$> partitionWithSOACS (fromIntegral k') lam' arrs
+      where
+        fromInt32 (Literal (SignedValue (Int32Value k')) _) = Just k'
+        fromInt32 (IntLit k' (Info (E.Scalar (E.Prim (Signed Int32)))) _) = Just $ fromInteger k'
+        fromInt32 _ = Nothing
+    handleSOACs [TupLit [lam, ne, arr] _] "reduce" = Just $ \desc ->
+      internaliseScanOrReduce desc "reduce" reduce (lam, ne, arr, loc)
+      where
+        reduce w red_lam nes arrs =
+          I.Screma w arrs
+            <$> I.reduceSOAC [Reduce Noncommutative red_lam nes]
+    handleSOACs [TupLit [lam, ne, arr] _] "reduce_comm" = Just $ \desc ->
+      internaliseScanOrReduce desc "reduce" reduce (lam, ne, arr, loc)
+      where
+        reduce w red_lam nes arrs =
+          I.Screma w arrs
+            <$> I.reduceSOAC [Reduce Commutative red_lam nes]
+    handleSOACs [TupLit [lam, ne, arr] _] "scan" = Just $ \desc ->
+      internaliseScanOrReduce desc "scan" reduce (lam, ne, arr, loc)
+      where
+        reduce w scan_lam nes arrs =
+          I.Screma w arrs <$> I.scanSOAC [Scan scan_lam nes]
+    handleSOACs [TupLit [op, f, arr] _] "reduce_stream" = Just $ \desc ->
+      internaliseStreamRed desc InOrder Noncommutative op f arr
+    handleSOACs [TupLit [op, f, arr] _] "reduce_stream_per" = Just $ \desc ->
+      internaliseStreamRed desc Disorder Commutative op f arr
+    handleSOACs [TupLit [f, arr] _] "map_stream" = Just $ \desc ->
+      internaliseStreamMap desc InOrder f arr
+    handleSOACs [TupLit [f, arr] _] "map_stream_per" = Just $ \desc ->
+      internaliseStreamMap desc Disorder f arr
+    handleSOACs [TupLit [rf, dest, op, ne, buckets, img] _] "hist" = Just $ \desc ->
+      internaliseHist desc rf dest op ne buckets img loc
+    handleSOACs _ _ = Nothing
+
+    handleAccs [TupLit [dest, f, bs] _] "scatter_stream" = Just $ \desc ->
+      internaliseStreamAcc desc dest Nothing f bs
+    handleAccs [TupLit [dest, op, ne, f, bs] _] "hist_stream" = Just $ \desc ->
+      internaliseStreamAcc desc dest (Just (op, ne)) f bs
+    handleAccs [TupLit [acc, i, v] _] "acc_write" = Just $ \desc -> do
+      acc' <- head <$> internaliseExpToVars "acc" acc
+      i' <- internaliseExp1 "acc_i" i
+      vs <- internaliseExp "acc_v" v
+      fmap pure $ letSubExp desc $ BasicOp $ UpdateAcc acc' [i'] vs
+    handleAccs _ _ = Nothing
+
+    handleRest [x] "!" = Just $ complementF x
+    handleRest [x] "opaque" = Just $ \desc ->
+      mapM (letSubExp desc . BasicOp . Opaque) =<< internaliseExp "opaque_arg" x
+    handleRest [E.TupLit [a, si, v] _] "scatter" = Just $ scatterF 1 a si v
+    handleRest [E.TupLit [a, si, v] _] "scatter_2d" = Just $ scatterF 2 a si v
+    handleRest [E.TupLit [a, si, v] _] "scatter_3d" = Just $ scatterF 3 a si v
+    handleRest [E.TupLit [n, m, arr] _] "unflatten" = Just $ \desc -> do
+      arrs <- internaliseExpToVars "unflatten_arr" arr
+      n' <- internaliseExp1 "n" n
+      m' <- internaliseExp1 "m" m
+      -- The unflattened dimension needs to have the same number of elements
+      -- as the original dimension.
+      old_dim <- I.arraysSize 0 <$> mapM lookupType arrs
+      dim_ok <-
+        letSubExp "dim_ok"
+          =<< eCmpOp
+            (I.CmpEq I.int64)
+            (eBinOp (I.Mul Int64 I.OverflowUndef) (eSubExp n') (eSubExp m'))
+            (eSubExp old_dim)
+      dim_ok_cert <-
+        assert
+          "dim_ok_cert"
+          dim_ok
+          "new shape has different number of elements than old shape"
+          loc
+      certifying dim_ok_cert $
+        forM arrs $ \arr' -> do
+          arr_t <- lookupType arr'
+          letSubExp desc $
+            I.BasicOp $
+              I.Reshape (reshapeOuter [DimNew n', DimNew m'] 1 $ I.arrayShape arr_t) arr'
+    handleRest [arr] "flatten" = Just $ \desc -> do
+      arrs <- internaliseExpToVars "flatten_arr" arr
+      forM arrs $ \arr' -> do
+        arr_t <- lookupType arr'
+        let n = arraySize 0 arr_t
+            m = arraySize 1 arr_t
+        k <- letSubExp "flat_dim" $ I.BasicOp $ I.BinOp (Mul Int64 I.OverflowUndef) n m
+        letSubExp desc $
+          I.BasicOp $
+            I.Reshape (reshapeOuter [DimNew k] 2 $ I.arrayShape arr_t) arr'
+    handleRest [TupLit [x, y] _] "concat" = Just $ \desc -> do
+      xs <- internaliseExpToVars "concat_x" x
+      ys <- internaliseExpToVars "concat_y" y
+      outer_size <- arraysSize 0 <$> mapM lookupType xs
+      let sumdims xsize ysize =
+            letSubExp "conc_tmp" $
+              I.BasicOp $
+                I.BinOp (I.Add I.Int64 I.OverflowUndef) xsize ysize
+      ressize <-
+        foldM sumdims outer_size
+          =<< mapM (fmap (arraysSize 0) . mapM lookupType) [ys]
+
+      let conc xarr yarr =
+            I.BasicOp $ I.Concat 0 xarr [yarr] ressize
+      letSubExps desc $ zipWith conc xs ys
+    handleRest [TupLit [offset, e] _] "rotate" = Just $ \desc -> do
+      offset' <- internaliseExp1 "rotation_offset" offset
+      internaliseOperation desc e $ \v -> do
+        r <- I.arrayRank <$> lookupType v
+        let zero = intConst Int64 0
+            offsets = offset' : replicate (r -1) zero
+        return $ I.Rotate offsets v
+    handleRest [e] "transpose" = Just $ \desc ->
+      internaliseOperation desc e $ \v -> do
+        r <- I.arrayRank <$> lookupType v
+        return $ I.Rearrange ([1, 0] ++ [2 .. r -1]) v
+    handleRest [TupLit [x, y] _] "zip" = Just $ \desc ->
+      mapM (letSubExp "zip_copy" . BasicOp . Copy)
+        =<< ( (++)
+                <$> internaliseExpToVars (desc ++ "_zip_x") x
+                <*> internaliseExpToVars (desc ++ "_zip_y") y
+            )
+    handleRest [x] "unzip" = Just $ flip internaliseExp x
+    handleRest [x] "trace" = Just $ flip internaliseExp x
+    handleRest [x] "break" = Just $ flip internaliseExp x
+    handleRest _ _ = Nothing
+
+    toSigned int_to e desc = do
+      e' <- internaliseExp1 "trunc_arg" e
+      case E.typeOf e of
+        E.Scalar (E.Prim E.Bool) ->
+          letTupExp' desc $
+            I.If
+              e'
+              (resultBody [intConst int_to 1])
+              (resultBody [intConst int_to 0])
+              $ ifCommon [I.Prim $ I.IntType int_to]
+        E.Scalar (E.Prim (E.Signed int_from)) ->
+          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.SExt int_from int_to) e'
+        E.Scalar (E.Prim (E.Unsigned int_from)) ->
+          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.ZExt int_from int_to) e'
+        E.Scalar (E.Prim (E.FloatType float_from)) ->
+          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.FPToSI float_from int_to) e'
+        _ -> error "Futhark.Internalise: non-numeric type in ToSigned"
+
+    toUnsigned int_to e desc = do
+      e' <- internaliseExp1 "trunc_arg" e
+      case E.typeOf e of
+        E.Scalar (E.Prim E.Bool) ->
+          letTupExp' desc $
+            I.If
+              e'
+              (resultBody [intConst int_to 1])
+              (resultBody [intConst int_to 0])
+              $ ifCommon [I.Prim $ I.IntType int_to]
+        E.Scalar (E.Prim (E.Signed int_from)) ->
+          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.ZExt int_from int_to) e'
+        E.Scalar (E.Prim (E.Unsigned int_from)) ->
+          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.ZExt int_from int_to) e'
+        E.Scalar (E.Prim (E.FloatType float_from)) ->
+          letTupExp' desc $ I.BasicOp $ I.ConvOp (I.FPToUI float_from int_to) e'
+        _ -> error "Futhark.Internalise.internaliseExp: non-numeric type in ToUnsigned"
+
+    complementF e desc = do
+      e' <- internaliseExp1 "complement_arg" e
+      et <- subExpType e'
+      case et of
+        I.Prim (I.IntType t) ->
+          letTupExp' desc $ I.BasicOp $ I.UnOp (I.Complement t) e'
+        I.Prim I.Bool ->
+          letTupExp' desc $ I.BasicOp $ I.UnOp I.Not e'
+        _ ->
+          error "Futhark.Internalise.internaliseExp: non-int/bool type in Complement"
+
+    scatterF dim a si v desc = do
+      si' <- internaliseExpToVars "write_arg_i" si
+      svs <- internaliseExpToVars "write_arg_v" v
+      sas <- internaliseExpToVars "write_arg_a" a
+
+      si_w <- I.arraysSize 0 <$> mapM lookupType si'
+      sv_ts <- mapM lookupType svs
+
+      svs' <- forM (zip svs sv_ts) $ \(sv, sv_t) -> do
+        let sv_shape = I.arrayShape sv_t
+            sv_w = arraySize 0 sv_t
+
+        -- Generate an assertion and reshapes to ensure that sv and si' are the same
+        -- size.
+        cmp <-
+          letSubExp "write_cmp" $
+            I.BasicOp $
+              I.CmpOp (I.CmpEq I.int64) si_w sv_w
+        c <-
+          assert
+            "write_cert"
+            cmp
+            "length of index and value array does not match"
+            loc
+        certifying c $
+          letExp (baseString sv ++ "_write_sv") $
+            I.BasicOp $ I.Reshape (reshapeOuter [DimCoercion si_w] 1 sv_shape) sv
+
+      indexType <- fmap rowType <$> mapM lookupType si'
+      indexName <- mapM (\_ -> newVName "write_index") indexType
+      valueNames <- replicateM (length sv_ts) $ newVName "write_value"
+
+      sa_ts <- mapM lookupType sas
+      let bodyTypes = concat (replicate (length sv_ts) indexType) ++ map (I.stripArray dim) sa_ts
+          paramTypes = indexType <> map rowType sv_ts
+          bodyNames = indexName <> valueNames
+          bodyParams = zipWith I.Param bodyNames paramTypes
+
+      -- This body is pretty boring right now, as every input is exactly the output.
+      -- But it can get funky later on if fused with something else.
+      body <- localScope (scopeOfLParams bodyParams) . buildBody_ $ do
+        let outs = concat (replicate (length valueNames) indexName) ++ valueNames
+        results <- forM outs $ \name ->
+          letSubExp "write_res" $ I.BasicOp $ I.SubExp $ I.Var name
+        ensureResultShape
+          "scatter value has wrong size"
+          loc
+          bodyTypes
+          results
+
+      let lam =
+            I.Lambda
+              { I.lambdaParams = bodyParams,
+                I.lambdaReturnType = bodyTypes,
+                I.lambdaBody = body
+              }
+          sivs = si' <> svs'
+
+      let sa_ws = map (Shape . take dim . arrayDims) sa_ts
+      letTupExp' desc $ I.Op $ I.Scatter si_w lam sivs $ zip3 sa_ws (repeat 1) sas
+
+funcall ::
+  String ->
+  QualName VName ->
+  [SubExp] ->
+  SrcLoc ->
+  InternaliseM ([SubExp], [I.ExtType])
+funcall desc (QualName _ fname) args loc = do
+  (shapes, value_paramts, fun_params, rettype_fun) <-
+    lookupFunction fname
+  argts <- mapM subExpType args
+
+  shapeargs <- argShapes shapes fun_params argts
+  let diets =
+        replicate (length shapeargs) I.ObservePrim
+          ++ map I.diet value_paramts
+  args' <-
+    ensureArgShapes
+      "function arguments of wrong shape"
+      loc
+      (map I.paramName fun_params)
+      (map I.paramType fun_params)
+      (shapeargs ++ args)
+  argts' <- mapM subExpType args'
+  case rettype_fun $ zip args' argts' of
+    Nothing ->
+      error $
+        concat
+          [ "Cannot apply ",
+            pretty fname,
+            " to ",
+            show (length args'),
+            " arguments\n ",
+            pretty args',
+            "\nof types\n ",
+            pretty argts',
+            "\nFunction has ",
+            show (length fun_params),
+            " parameters\n ",
+            pretty fun_params
+          ]
+    Just ts -> do
+      safety <- askSafety
+      attrs <- asks envAttrs
+      ses <-
+        attributing attrs $
+          letTupExp' desc $
+            I.Apply (internaliseFunName fname) (zip args' diets) ts (safety, loc, mempty)
+      return (ses, map I.fromDecl ts)
+
+-- Bind existential names defined by an expression, based on the
+-- concrete values that expression evaluated to.  This most
+-- importantly should be done after function calls, but also
+-- everything else that can produce existentials in the source
+-- language.
+bindExtSizes :: AppRes -> [SubExp] -> InternaliseM ()
+bindExtSizes (AppRes ret retext) ses = do
+  ts <- internaliseType $ E.toStruct ret
+  ses_ts <- mapM subExpType ses
+
+  let combine t1 t2 =
+        mconcat $ zipWith combine' (arrayExtDims t1) (arrayDims t2)
+      combine' (I.Free (I.Var v)) se
+        | v `elem` retext = M.singleton v se
+      combine' _ _ = mempty
+
+  forM_ (M.toList $ mconcat $ zipWith combine ts ses_ts) $ \(v, se) ->
+    letBindNames [v] $ BasicOp $ SubExp se
+
+askSafety :: InternaliseM Safety
+askSafety = do
+  check <- asks envDoBoundsChecks
+  return $ if check then I.Safe else I.Unsafe
+
+-- Implement partitioning using maps, scans and writes.
+partitionWithSOACS :: Int -> I.Lambda -> [I.VName] -> InternaliseM ([I.SubExp], [I.SubExp])
+partitionWithSOACS k lam arrs = do
+  arr_ts <- mapM lookupType arrs
+  let w = arraysSize 0 arr_ts
+  classes_and_increments <- letTupExp "increments" $ I.Op $ I.Screma w arrs (mapSOAC lam)
+  (classes, increments) <- case classes_and_increments of
+    classes : increments -> return (classes, take k increments)
+    _ -> error "partitionWithSOACS"
+
+  add_lam_x_params <-
+    replicateM k $ I.Param <$> newVName "x" <*> pure (I.Prim int64)
+  add_lam_y_params <-
+    replicateM k $ I.Param <$> newVName "y" <*> pure (I.Prim int64)
+  add_lam_body <- runBodyBinder $
+    localScope (scopeOfLParams $ add_lam_x_params ++ add_lam_y_params) $
+      fmap resultBody $
+        forM (zip add_lam_x_params add_lam_y_params) $ \(x, y) ->
+          letSubExp "z" $
+            I.BasicOp $
+              I.BinOp
+                (I.Add Int64 I.OverflowUndef)
+                (I.Var $ I.paramName x)
+                (I.Var $ I.paramName y)
+  let add_lam =
+        I.Lambda
+          { I.lambdaBody = add_lam_body,
+            I.lambdaParams = add_lam_x_params ++ add_lam_y_params,
+            I.lambdaReturnType = replicate k $ I.Prim int64
+          }
+      nes = replicate (length increments) $ intConst Int64 0
+
+  scan <- I.scanSOAC [I.Scan add_lam nes]
+  all_offsets <- letTupExp "offsets" $ I.Op $ I.Screma w increments scan
+
+  -- We have the offsets for each of the partitions, but we also need
+  -- the total sizes, which are the last elements in the offests.  We
+  -- just have to be careful in case the array is empty.
+  last_index <- letSubExp "last_index" $ I.BasicOp $ I.BinOp (I.Sub Int64 OverflowUndef) w $ constant (1 :: Int64)
+  nonempty_body <- runBodyBinder $
+    fmap resultBody $
+      forM all_offsets $ \offset_array ->
+        letSubExp "last_offset" $ I.BasicOp $ I.Index offset_array [I.DimFix last_index]
+  let empty_body = resultBody $ replicate k $ constant (0 :: Int64)
+  is_empty <- letSubExp "is_empty" $ I.BasicOp $ I.CmpOp (CmpEq int64) w $ constant (0 :: Int64)
+  sizes <-
+    letTupExp "partition_size" $
+      I.If is_empty empty_body nonempty_body $
+        ifCommon $ replicate k $ I.Prim int64
+
+  -- The total size of all partitions must necessarily be equal to the
+  -- size of the input array.
+
+  -- Create scratch arrays for the result.
+  blanks <- forM arr_ts $ \arr_t ->
+    letExp "partition_dest" $
+      I.BasicOp $ Scratch (I.elemType arr_t) (w : drop 1 (I.arrayDims arr_t))
+
+  -- Now write into the result.
+  write_lam <- do
+    c_param <- I.Param <$> newVName "c" <*> pure (I.Prim int64)
+    offset_params <- replicateM k $ I.Param <$> newVName "offset" <*> pure (I.Prim int64)
+    value_params <- forM arr_ts $ \arr_t ->
+      I.Param <$> newVName "v" <*> pure (I.rowType arr_t)
+    (offset, offset_stms) <-
+      collectStms $
+        mkOffsetLambdaBody
+          (map I.Var sizes)
+          (I.Var $ I.paramName c_param)
+          0
+          offset_params
+    return
+      I.Lambda
+        { I.lambdaParams = c_param : offset_params ++ value_params,
+          I.lambdaReturnType =
+            replicate (length arr_ts) (I.Prim int64)
+              ++ map I.rowType arr_ts,
+          I.lambdaBody =
+            mkBody offset_stms $
+              replicate (length arr_ts) offset
+                ++ map (I.Var . I.paramName) value_params
+        }
+  results <-
+    letTupExp "partition_res" $
+      I.Op $
+        I.Scatter
+          w
+          write_lam
+          (classes : all_offsets ++ arrs)
+          $ zip3 (repeat $ Shape [w]) (repeat 1) blanks
+  sizes' <-
+    letSubExp "partition_sizes" $
+      I.BasicOp $
+        I.ArrayLit (map I.Var sizes) $ I.Prim int64
+  return (map I.Var results, [sizes'])
+  where
+    mkOffsetLambdaBody ::
+      [SubExp] ->
+      SubExp ->
+      Int ->
+      [I.LParam] ->
+      InternaliseM SubExp
+    mkOffsetLambdaBody _ _ _ [] =
+      return $ constant (-1 :: Int64)
+    mkOffsetLambdaBody sizes c i (p : ps) = do
+      is_this_one <-
+        letSubExp "is_this_one" $
+          I.BasicOp $
+            I.CmpOp (CmpEq int64) c $
+              intConst Int64 $ toInteger i
+      next_one <- mkOffsetLambdaBody sizes c (i + 1) ps
+      this_one <-
+        letSubExp "this_offset"
+          =<< foldBinOp
+            (Add Int64 OverflowUndef)
+            (constant (-1 :: Int64))
+            (I.Var (I.paramName p) : take i sizes)
+      letSubExp "total_res" $
+        I.If
+          is_this_one
+          (resultBody [this_one])
+          (resultBody [next_one])
+          $ ifCommon [I.Prim int64]
+
+typeExpForError :: E.TypeExp VName -> InternaliseM [ErrorMsgPart SubExp]
+typeExpForError (E.TEVar qn _) =
+  return [ErrorString $ pretty qn]
+typeExpForError (E.TEUnique te _) =
+  ("*" :) <$> typeExpForError te
+typeExpForError (E.TEArray te d _) = do
+  d' <- dimExpForError d
+  te' <- typeExpForError te
+  return $ ["[", d', "]"] ++ te'
+typeExpForError (E.TETuple tes _) = do
+  tes' <- mapM typeExpForError tes
+  return $ ["("] ++ intercalate [", "] tes' ++ [")"]
+typeExpForError (E.TERecord fields _) = do
+  fields' <- mapM onField fields
+  return $ ["{"] ++ intercalate [", "] fields' ++ ["}"]
+  where
+    onField (k, te) =
+      (ErrorString (pretty k ++ ": ") :) <$> typeExpForError te
+typeExpForError (E.TEArrow _ t1 t2 _) = do
+  t1' <- typeExpForError t1
+  t2' <- typeExpForError t2
+  return $ t1' ++ [" -> "] ++ t2'
+typeExpForError (E.TEApply t arg _) = do
+  t' <- typeExpForError t
+  arg' <- case arg of
+    TypeArgExpType argt -> typeExpForError argt
+    TypeArgExpDim d _ -> pure <$> dimExpForError d
+  return $ t' ++ [" "] ++ arg'
+typeExpForError (E.TESum cs _) = do
+  cs' <- mapM (onClause . snd) cs
+  return $ intercalate [" | "] cs'
+  where
+    onClause c = do
+      c' <- mapM typeExpForError c
+      return $ intercalate [" "] c'
+
+dimExpForError :: E.DimExp VName -> InternaliseM (ErrorMsgPart SubExp)
+dimExpForError (DimExpNamed d _) = do
+  substs <- lookupSubst $ E.qualLeaf d
+  d' <- case substs of
+    Just [v] -> return v
+    _ -> return $ I.Var $ E.qualLeaf d
+  return $ ErrorInt64 d'
+dimExpForError (DimExpConst d _) =
+  return $ ErrorString $ pretty d
+dimExpForError DimExpAny = return ""
+
+-- A smart constructor that compacts neighbouring literals for easier
+-- reading in the IR.
+errorMsg :: [ErrorMsgPart a] -> ErrorMsg a
+errorMsg = ErrorMsg . compact
+  where
+    compact [] = []
+    compact (ErrorString x : ErrorString y : parts) =
+      compact (ErrorString (x ++ y) : parts)
+    compact (x : y) = x : compact y
diff --git a/src/Futhark/Internalise/Monad.hs b/src/Futhark/Internalise/Monad.hs
--- a/src/Futhark/Internalise/Monad.hs
+++ b/src/Futhark/Internalise/Monad.hs
@@ -29,7 +29,8 @@
 where
 
 import Control.Monad.Except
-import Control.Monad.RWS
+import Control.Monad.Reader
+import Control.Monad.State
 import qualified Data.Map.Strict as M
 import Futhark.IR.SOACS
 import Futhark.MonadFreshNames
@@ -60,29 +61,13 @@
   { stateNameSource :: VNameSource,
     stateFunTable :: FunTable,
     stateConstSubsts :: VarSubstitutions,
-    stateConstScope :: Scope SOACS
+    stateConstScope :: Scope SOACS,
+    stateFuns :: [FunDef SOACS]
   }
 
-data InternaliseResult = InternaliseResult (Stms SOACS) [FunDef SOACS]
-
-instance Semigroup InternaliseResult where
-  InternaliseResult xs1 ys1 <> InternaliseResult xs2 ys2 =
-    InternaliseResult (xs1 <> xs2) (ys1 <> ys2)
-
-instance Monoid InternaliseResult where
-  mempty = InternaliseResult mempty mempty
-
 newtype InternaliseM a
   = InternaliseM
-      ( BinderT
-          SOACS
-          ( RWS
-              InternaliseEnv
-              InternaliseResult
-              InternaliseState
-          )
-          a
-      )
+      (BinderT SOACS (ReaderT InternaliseEnv (State InternaliseState)) a)
   deriving
     ( Functor,
       Applicative,
@@ -94,7 +79,7 @@
       LocalScope SOACS
     )
 
-instance (Monoid w, Monad m) => MonadFreshNames (RWST r w InternaliseState m) where
+instance MonadFreshNames (State InternaliseState) where
   getNameSource = gets stateNameSource
   putNameSource src = modify $ \s -> s {stateNameSource = src}
 
@@ -114,9 +99,9 @@
   m (Stms SOACS, [FunDef SOACS])
 runInternaliseM safe (InternaliseM m) =
   modifyNameSource $ \src ->
-    let ((_, consts), s, InternaliseResult _ funs) =
-          runRWS (runBinderT m mempty) newEnv (newState src)
-     in ((consts, funs), stateNameSource s)
+    let ((_, consts), s) =
+          runState (runReaderT (runBinderT m mempty) newEnv) (newState src)
+     in ((consts, reverse $ stateFuns s), stateNameSource s)
   where
     newEnv =
       InternaliseEnv
@@ -130,7 +115,8 @@
         { stateNameSource = src,
           stateFunTable = mempty,
           stateConstSubsts = mempty,
-          stateConstScope = mempty
+          stateConstScope = mempty,
+          stateFuns = mempty
         }
 
 substitutingVars :: VarSubstitutions -> InternaliseM a -> InternaliseM a
@@ -144,8 +130,7 @@
 
 -- | Add a function definition to the program being constructed.
 addFunDef :: FunDef SOACS -> InternaliseM ()
-addFunDef fd =
-  InternaliseM $ lift $ tell $ InternaliseResult mempty [fd]
+addFunDef fd = modify $ \s -> s {stateFuns = fd : stateFuns s}
 
 lookupFunction' :: VName -> InternaliseM (Maybe FunInfo)
 lookupFunction' fname = gets $ M.lookup fname . stateFunTable
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
@@ -200,8 +200,11 @@
 
 -- | How many core language values are needed to represent one source
 -- language value of the given type?
-internalisedTypeSize :: E.TypeBase (E.DimDecl VName) () -> InternaliseM Int
-internalisedTypeSize = fmap length . internaliseType
+internalisedTypeSize :: E.TypeBase (E.DimDecl VName) als -> InternaliseM Int
+-- A few special cases for performance.
+internalisedTypeSize (E.Scalar (E.Prim _)) = pure 1
+internalisedTypeSize (E.Array _ _ (E.Prim _) _) = pure 1
+internalisedTypeSize t = length <$> internaliseType (t `E.setAliases` ())
 
 -- | Convert an external primitive to an internal primitive.
 internalisePrimType :: E.PrimType -> I.PrimType
diff --git a/src/Futhark/Optimise/Fusion.hs b/src/Futhark/Optimise/Fusion.hs
--- a/src/Futhark/Optimise/Fusion.hs
+++ b/src/Futhark/Optimise/Fusion.hs
@@ -425,8 +425,10 @@
   --
   -- (ii) check whether fusing @soac@ will violate any in-place update
   --      restriction, e.g., would move an input array past its in-place update.
-  let all_used_names = namesToList $ mconcat [lam_used_nms, namesFromList inp_nms, namesFromList other_nms]
-      has_inplace ker = any (`nameIn` inplace ker) all_used_names
+  all_used_names <-
+    fmap mconcat . mapM varAliases . namesToList $
+      mconcat [lam_used_nms, namesFromList inp_nms, namesFromList other_nms]
+  let has_inplace ker = inplace ker `namesIntersect` all_used_names
       ok_inplace = not $ any has_inplace old_kers
   --
   -- (iii)  there are some kernels that use some of `out_idds' as inputs
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
@@ -11,7 +11,9 @@
 import qualified Data.Map.Strict as M
 import Data.Maybe (mapMaybe)
 import qualified Data.Sequence as Seq
+import qualified Futhark.Analysis.Alias as Alias
 import Futhark.IR.Kernels
+import Futhark.IR.Prop.Aliases (consumedInStm)
 import Futhark.MonadFreshNames
 import Futhark.Optimise.BlkRegTiling
 import Futhark.Optimise.TileLoops.Shared
@@ -255,13 +257,25 @@
     invariantTo names stm =
       case patternNames (stmPattern stm) of
         [] -> True -- Does not matter.
-        v : _ ->
-          not $
-            any (`nameIn` names) $
-              namesToList $
-                M.findWithDefault mempty v variance
+        v : _ -> not $ any (`nameIn` names) $ namesToList $ M.findWithDefault mempty v variance
+
+    consumed v = v `nameIn` consumed_in_prestms
+    consumedStm stm = any consumed (patternNames (stmPattern stm))
+
+    later_consumed =
+      namesFromList $
+        concatMap (patternNames . stmPattern) $
+          stmsToList $ Seq.filter consumedStm prestms
+
+    groupInvariant stm =
+      invariantTo private stm
+        && not (any (`nameIn` later_consumed) (patternNames (stmPattern stm)))
+        && invariantTo later_consumed stm
     (invariant_prestms, variant_prestms) =
-      Seq.partition (invariantTo private) prestms
+      Seq.partition groupInvariant prestms
+
+    consumed_in_prestms =
+      foldMap consumedInStm $ fst $ Alias.analyseStms mempty prestms
 
     mustBeInlinedExp (BasicOp (Index _ slice)) = not $ null $ sliceDims slice
     mustBeInlinedExp (BasicOp Rotate {}) = True
diff --git a/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs b/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs
--- a/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs
+++ b/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs
@@ -21,7 +21,6 @@
 
 import Control.Monad
 import Control.Monad.Writer
-import Data.List ()
 import Futhark.Analysis.PrimExp
 import Futhark.IR
 import Futhark.IR.Prop.Aliases
@@ -244,11 +243,11 @@
   m ()
 readKernelInput inp = do
   let pe = PatElem (kernelInputName inp) $ kernelInputType inp
-  arr_t <- lookupType $ kernelInputArray inp
   letBind (Pattern [] [pe]) . BasicOp $
-    case arr_t of
+    case kernelInputType inp of
       Acc {} ->
         SubExp $ Var $ kernelInputArray inp
       _ ->
         Index (kernelInputArray inp) $
-          fullSlice arr_t $ map DimFix $ kernelInputIndices inp
+          map DimFix (kernelInputIndices inp)
+            ++ map sliceDim (arrayDims (kernelInputType inp))
diff --git a/src/Futhark/Script.hs b/src/Futhark/Script.hs
--- a/src/Futhark/Script.hs
+++ b/src/Futhark/Script.hs
@@ -9,6 +9,7 @@
   ( -- * Server
     ScriptServer,
     withScriptServer,
+    withScriptServer',
 
     -- * Expressions, values, and types
     Func (..),
@@ -18,6 +19,8 @@
     ScriptValueType (..),
     ScriptValue (..),
     scriptValueType,
+    serverVarsInValue,
+    ValOrVar (..),
     ExpValue,
 
     -- * Evaluation
@@ -35,6 +38,7 @@
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import Data.Char
 import Data.Foldable (toList)
+import Data.Functor
 import Data.IORef
 import Data.List (intersperse)
 import qualified Data.Map as M
@@ -56,12 +60,18 @@
 -- more convenient.
 data ScriptServer = ScriptServer Server (IORef Int)
 
+-- | Run an action with a 'ScriptServer' produced by an existing
+-- 'Server', without shutting it down at the end.
+withScriptServer' :: MonadIO m => Server -> (ScriptServer -> m a) -> m a
+withScriptServer' server f = do
+  counter <- liftIO $ newIORef 0
+  f $ ScriptServer server counter
+
 -- | Start a server, execute an action, then shut down the server.
 -- Similar to 'withServer'.
 withScriptServer :: FilePath -> [FilePath] -> (ScriptServer -> IO a) -> IO a
-withScriptServer prog options f = withServer prog options $ \server -> do
-  counter <- newIORef 0
-  f $ ScriptServer server counter
+withScriptServer prog options f =
+  withServer prog options $ flip withScriptServer' f
 
 -- | A function called in a 'Call' expression can be either a Futhark
 -- function or a builtin function.
@@ -78,6 +88,7 @@
   | Tuple [Exp]
   | Record [(T.Text, Exp)]
   | StringLit T.Text
+  | Let [VarName] Exp Exp
   | -- | Server-side variable, *not* Futhark variable (these are
     -- handled in 'Call').
     ServerVar TypeName VarName
@@ -91,6 +102,12 @@
   ppr = pprPrec 0
   pprPrec _ (ServerVar _ v) = "$" <> ppr v
   pprPrec _ (Const v) = ppr v
+  pprPrec i (Let pat e1 e2) =
+    parensIf (i > 0) $ "let" <+> pat' <+> equals <+> ppr e1 <+> "in" <+> ppr e2
+    where
+      pat' = case pat of
+        [x] -> ppr x
+        _ -> parens $ commasep $ map ppr pat
   pprPrec _ (Call v []) = ppr v
   pprPrec i (Call v args) =
     parensIf (i > 0) $ ppr v <+> spread (map (pprPrec 1) args)
@@ -116,27 +133,42 @@
 parseExp :: Parser () -> Parser Exp
 parseExp sep =
   choice
-    [ inParens sep (mkTuple <$> (parseExp sep `sepBy` pComma)),
+    [ lexeme sep "let" $> Let
+        <*> pPattern <* lexeme sep "="
+        <*> parseExp sep <* lexeme sep "in"
+        <*> parseExp sep,
+      inParens sep (mkTuple <$> (parseExp sep `sepBy` pComma)),
       inBraces sep (Record <$> (pField `sepBy` pComma)),
-      Call <$> lexeme sep parseFunc <*> many (parseExp sep),
+      Call <$> parseFunc <*> many (parseExp sep),
       Const <$> V.parseValue sep,
       StringLit . T.pack <$> lexeme sep ("\"" *> manyTill charLiteral "\"")
     ]
+    <?> "expression"
   where
-    pField = (,) <$> lexeme sep parseEntryName <*> (pEquals *> parseExp sep)
+    pField = (,) <$> pVarName <*> (pEquals *> parseExp sep)
     pEquals = lexeme sep "="
     pComma = lexeme sep ","
     mkTuple [v] = v
     mkTuple vs = Tuple vs
 
+    pPattern =
+      choice
+        [ inParens sep $ pVarName `sepBy` pComma,
+          pure <$> pVarName
+        ]
+
     parseFunc =
       choice
-        [ FuncBuiltin <$> ("$" *> parseEntryName),
-          FuncFut <$> parseEntryName
+        [ FuncBuiltin <$> ("$" *> pVarName),
+          FuncFut <$> pVarName
         ]
 
-    parseEntryName =
-      fmap T.pack $ (:) <$> satisfy isAlpha <*> many (satisfy constituent)
+    reserved = ["let", "in"]
+
+    pVarName = lexeme sep . try $ do
+      v <- fmap T.pack $ (:) <$> satisfy isAlpha <*> many (satisfy constituent)
+      guard $ v `notElem` reserved
+      pure v
       where
         constituent c = isAlphaNum c || c == '_'
 
@@ -144,12 +176,6 @@
 prettyFailure (CmdFailure bef aft) =
   T.unlines $ bef ++ aft
 
-cmdMaybe :: (MonadError T.Text m, MonadIO m) => IO (Maybe CmdFailure) -> m ()
-cmdMaybe m = maybe (pure ()) (throwError . prettyFailure) =<< liftIO m
-
-cmdEither :: (MonadError T.Text m, MonadIO m) => IO (Either CmdFailure a) -> m a
-cmdEither m = either (throwError . prettyFailure) pure =<< liftIO m
-
 readVar :: (MonadError T.Text m, MonadIO m) => Server -> VarName -> m V.Value
 readVar server v =
   either throwError pure <=< liftIO $
@@ -184,6 +210,7 @@
   | -- | Ins, then outs.  Yes, this is the opposite of more or less
     -- everywhere else.
     SFun EntryName [TypeName] [TypeName] [ScriptValue v]
+  deriving (Show)
 
 instance Functor ScriptValue where
   fmap = fmapDefault
@@ -212,6 +239,7 @@
         [out] -> strictText out
         _ -> parens $ commasep $ map strictText outs
 
+-- | A Haskell-level value or a variable on the server.
 data ValOrVar = VVal V.Value | VVar VarName
   deriving (Show)
 
@@ -224,6 +252,7 @@
 scriptValueType (SValue t _) = STValue t
 scriptValueType (SFun _ ins outs _) = STFun ins outs
 
+-- | The set of server-side variables in the value.
 serverVarsInValue :: ExpValue -> S.Set VarName
 serverVarsInValue = S.fromList . concatMap isVar . toList
   where
@@ -247,6 +276,9 @@
 -- | How to evaluate a builtin function.
 type EvalBuiltin m = T.Text -> [V.CompoundValue] -> m V.CompoundValue
 
+-- | Symbol table used for local variable lookups during expression evaluation.
+type VTable = M.Map VarName ExpValue
+
 -- | Evaluate a FutharkScript expression relative to some running server.
 evalExp ::
   forall m.
@@ -300,17 +332,33 @@
       simpleType (V.ValueAtom (STValue _)) = True
       simpleType _ = False
 
-      evalExp' :: Exp -> m ExpValue
-      evalExp' (ServerVar t v) =
+      letMatch :: [VarName] -> ExpValue -> m VTable
+      letMatch vs val
+        | vals <- V.unCompound val,
+          length vs == length vals =
+          pure $ M.fromList (zip vs vals)
+        | otherwise =
+          throwError $
+            "Pattern: " <> prettyTextOneLine vs
+              <> "\nDoes not match value of type: "
+              <> prettyTextOneLine (fmap scriptValueType val)
+
+      evalExp' :: VTable -> Exp -> m ExpValue
+      evalExp' _ (ServerVar t v) =
         pure $ V.ValueAtom $ SValue t $ VVar v
-      evalExp' (Call (FuncBuiltin name) es) = do
-        v <- builtin name =<< mapM (interValToVal <=< evalExp') es
+      evalExp' vtable (Call (FuncBuiltin name) es) = do
+        v <- builtin name =<< mapM (interValToVal <=< evalExp' vtable) es
         pure $ valToInterVal v
-      evalExp' (Call (FuncFut name) es) = do
+      evalExp' vtable (Call (FuncFut name) es)
+        | Just e <- M.lookup name vtable = do
+          unless (null es) $
+            throwError $ "Locally bound name cannot be invoked as a function: " <> prettyText name
+          pure e
+      evalExp' vtable (Call (FuncFut name) es) = do
         in_types <- cmdEither $ cmdInputs server name
         out_types <- cmdEither $ cmdOutputs server name
 
-        es' <- mapM evalExp' es
+        es' <- mapM (evalExp' vtable) es
         let es_types = map (fmap scriptValueType) es'
 
         unless (all simpleType es_types) $
@@ -318,15 +366,17 @@
             "Literate Futhark does not support passing script-constructed records, tuples, or functions to entry points.\n"
               <> "Create a Futhark wrapper function."
 
-        -- Careful to not require saturated application.
-        unless (and $ zipWith (==) es_types (map (V.ValueAtom . STValue) in_types)) $
-          throwError $
-            "Function \"" <> name <> "\" expects arguments of types:\n"
-              <> prettyText (V.mkCompound $ map V.ValueAtom in_types)
-              <> "\nBut called with arguments of types:\n"
-              <> prettyText (V.mkCompound $ map V.ValueAtom es_types)
+        -- Careful to not require saturated application, but do still
+        -- check for over-saturation.
+        let too_many = length es_types > length in_types
+            too_wrong = zipWith (/=) es_types (map (V.ValueAtom . STValue) in_types)
+        when (or $ too_many : too_wrong) . throwError $
+          "Function \"" <> name <> "\" expects arguments of types:\n"
+            <> prettyText (V.mkCompound $ map V.ValueAtom in_types)
+            <> "\nBut called with arguments of types:\n"
+            <> prettyText (V.mkCompound $ map V.ValueAtom es_types)
 
-        ins <- mapM (interValToVar <=< evalExp') es
+        ins <- mapM (interValToVar <=< evalExp' vtable) es
 
         if length in_types == length ins
           then do
@@ -336,19 +386,23 @@
           else
             pure . V.ValueAtom . SFun name in_types out_types $
               zipWith SValue in_types $ map VVar ins
-      evalExp' (StringLit s) =
+      evalExp' _ (StringLit s) =
         case V.putValue s of
           Just s' ->
             pure $ V.ValueAtom $ SValue (prettyText (V.valueType s')) $ VVal s'
           Nothing -> error $ "Unable to write value " ++ pretty s
-      evalExp' (Const val) =
+      evalExp' _ (Const val) =
         pure $ V.ValueAtom $ SValue (V.prettyValueTypeNoDims (V.valueType val)) $ VVal val
-      evalExp' (Tuple es) =
-        V.ValueTuple <$> mapM evalExp' es
-      evalExp' e@(Record m) = do
+      evalExp' vtable (Tuple es) =
+        V.ValueTuple <$> mapM (evalExp' vtable) es
+      evalExp' vtable e@(Record m) = do
         when (length (nubOrd (map fst m)) /= length (map fst m)) $
           throwError $ "Record " <> prettyText e <> " has duplicate fields."
-        V.ValueRecord <$> traverse evalExp' (M.fromList m)
+        V.ValueRecord <$> traverse (evalExp' vtable) (M.fromList m)
+      evalExp' vtable (Let pat e1 e2) = do
+        v <- evalExp' vtable e1
+        pat_vtable <- letMatch pat v
+        evalExp' (pat_vtable <> vtable) e2
 
   let freeNonresultVars v = do
         let v_vars = serverVarsInValue v
@@ -363,7 +417,7 @@
         -- Call.
         void $ liftIO $ cmdFree server =<< readIORef vars
         throwError e
-  (freeNonresultVars =<< evalExp' top_level_e) `catchError` freeVarsOnError
+  (freeNonresultVars =<< evalExp' mempty top_level_e) `catchError` freeVarsOnError
 
 -- | Read actual values from the server.  Fails for values that have
 -- no well-defined external representation.
@@ -405,6 +459,7 @@
 varsInExp (Record fs) = foldMap (foldMap varsInExp) fs
 varsInExp Const {} = mempty
 varsInExp StringLit {} = mempty
+varsInExp (Let pat e1 e2) = varsInExp e1 <> S.filter (`notElem` pat) (varsInExp e2)
 
 -- | Release all the server-side variables in the value.  Yes,
 -- FutharkScript has manual memory management...
diff --git a/src/Futhark/Server.hs b/src/Futhark/Server.hs
--- a/src/Futhark/Server.hs
+++ b/src/Futhark/Server.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Haskell code for interacting with a Futhark server program (a
@@ -13,15 +14,19 @@
     cmdStore,
     cmdCall,
     cmdFree,
+    cmdRename,
     cmdInputs,
     cmdOutputs,
     cmdClear,
     cmdReport,
+    cmdMaybe,
+    cmdEither,
   )
 where
 
 import Control.Exception
 import Control.Monad
+import Control.Monad.Except
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
@@ -180,6 +185,9 @@
 cmdFree :: Server -> [VarName] -> IO (Maybe CmdFailure)
 cmdFree s vs = helpCmd s $ "free" : vs
 
+cmdRename :: Server -> VarName -> VarName -> IO (Maybe CmdFailure)
+cmdRename s oldname newname = helpCmd s ["rename", oldname, newname]
+
 cmdInputs :: Server -> EntryName -> IO (Either CmdFailure [TypeName])
 cmdInputs s entry =
   sendCommand s ["inputs", entry]
@@ -193,3 +201,11 @@
 
 cmdReport :: Server -> IO (Either CmdFailure [T.Text])
 cmdReport s = sendCommand s ["report"]
+
+-- | Turn a 'Maybe'-producing command into a monadic action.
+cmdMaybe :: (MonadError T.Text m, MonadIO m) => IO (Maybe CmdFailure) -> m ()
+cmdMaybe = maybe (pure ()) (throwError . T.unlines . failureMsg) <=< liftIO
+
+-- | Turn an 'Either'-producing command into a monadic action.
+cmdEither :: (MonadError T.Text m, MonadIO m) => IO (Either CmdFailure a) -> m a
+cmdEither = either (throwError . T.unlines . failureMsg) pure <=< liftIO
diff --git a/src/Futhark/Test.hs b/src/Futhark/Test.hs
--- a/src/Futhark/Test.hs
+++ b/src/Futhark/Test.hs
@@ -14,8 +14,7 @@
     FutharkExe (..),
     getValues,
     getValuesBS,
-    withValuesFile,
-    checkValueTypes,
+    valuesAsVars,
     compareValues,
     checkResult,
     testRunReferenceOutput,
@@ -57,17 +56,19 @@
 import Data.List (foldl')
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import qualified Data.Set as S
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
 import Data.Void
 import Futhark.Analysis.Metrics.Type
 import Futhark.IR.Primitive (floatByteSize, intByteSize)
+import qualified Futhark.Script as Script
 import Futhark.Server
 import Futhark.Test.Values
 import Futhark.Test.Values.Parser
 import Futhark.Util (directoryContents, pmapIO)
-import Futhark.Util.Pretty (pretty, prettyText)
+import Futhark.Util.Pretty (pretty, prettyOneLine, prettyText, prettyTextOneLine)
 import Language.Futhark.Prop (primByteSize, primValueType)
 import Language.Futhark.Syntax (PrimType (..), PrimValue (..))
 import System.Directory
@@ -147,12 +148,14 @@
   }
   deriving (Show)
 
--- | Several Values - either literally, or by reference to a file, or
--- to be generated on demand.
+-- | Several values - either literally, or by reference to a file, or
+-- to be generated on demand.  All paths are relative to test program.
 data Values
   = Values [Value]
   | InFile FilePath
   | GenValues [GenValue]
+  | ScriptValues Script.Exp
+  | ScriptFile FilePath
   deriving (Show)
 
 data GenValue
@@ -287,7 +290,10 @@
       input <-
         if "random" `elem` tags
           then parseRandomValues
-          else parseValues
+          else
+            if "script" `elem` tags
+              then parseScriptValues
+              else parseValues
       expr <- parseExpectedResult
       return $ TestRun tags input expr i $ desc i input
 
@@ -309,6 +315,10 @@
             | otherwise -> s
     desc _ (GenValues gens) =
       unwords $ map genValueType gens
+    desc _ (ScriptValues e) =
+      prettyOneLine e
+    desc _ (ScriptFile path) =
+      path
 
 parseExpectedResult :: Parser (ExpectedResult Success)
 parseExpectedResult =
@@ -326,8 +336,17 @@
     -- newlines like ordinary characters, which is what we want.
       ThisError s <$> makeRegexOptsM blankCompOpt defaultExecOpt (T.unpack s)
 
+parseScriptValues :: Parser Values
+parseScriptValues =
+  choice
+    [ ScriptValues <$> braces (Script.parseExp postlexeme),
+      ScriptFile . T.unpack <$> (lexstr "@" *> lexeme nextWord)
+    ]
+  where
+    nextWord = takeWhileP Nothing $ not . isSpace
+
 parseRandomValues :: Parser Values
-parseRandomValues = GenValues <$> between (lexstr "{") (lexstr "}") (many parseGenValue)
+parseRandomValues = GenValues <$> braces (many parseGenValue)
 
 parseGenValue :: Parser GenValue
 parseGenValue =
@@ -489,64 +508,143 @@
       Values {} -> "<values>"
       InFile f -> f
       GenValues {} -> "<randomly generated>"
+      ScriptValues {} -> "<FutharkScript expression>"
+      ScriptFile f -> f
 
+readAndDecompress :: FilePath -> IO (Either DecompressError BS.ByteString)
+readAndDecompress file = E.try $ do
+  s <- BS.readFile file
+  E.evaluate $ decompress s
+
 -- | Extract a pretty representation of some 'Values'.  In the IO
 -- monad because this might involve reading from a file.  There is no
 -- guarantee that the resulting byte string yields a readable value.
-getValuesBS :: MonadIO m => FutharkExe -> FilePath -> Values -> m BS.ByteString
+getValuesBS :: (MonadFail m, MonadIO m) => FutharkExe -> FilePath -> Values -> m BS.ByteString
 getValuesBS _ _ (Values vs) =
   return $ BS.fromStrict $ T.encodeUtf8 $ T.unlines $ map prettyText vs
 getValuesBS _ dir (InFile file) =
   case takeExtension file of
     ".gz" -> liftIO $ do
-      s <- E.try readAndDecompress
+      s <- readAndDecompress file'
       case s of
-        Left e -> fail $ show file ++ ": " ++ show (e :: DecompressError)
+        Left e -> fail $ show file ++ ": " ++ show e
         Right s' -> return s'
     _ -> liftIO $ BS.readFile file'
   where
     file' = dir </> file
-    readAndDecompress = do
-      s <- BS.readFile file'
-      E.evaluate $ decompress s
 getValuesBS futhark dir (GenValues gens) =
   mconcat <$> mapM (getGenBS futhark dir) gens
+getValuesBS _ _ (ScriptValues e) =
+  fail $ "Cannot get values from FutharkScript expression: " <> prettyOneLine e
+getValuesBS _ _ (ScriptFile f) =
+  fail $ "Cannot get values from FutharkScript file: " <> f
 
--- | Evaluate an IO action while the values are available in the
--- binary format in a file by some name.  The file will be removed
--- after the action is done.
-withValuesFile ::
-  MonadIO m =>
+valueAsVar ::
+  (MonadError T.Text m, MonadIO m) =>
+  Server ->
+  VarName ->
+  TypeName ->
+  Value ->
+  m ()
+valueAsVar server v t val = do
+  cmdMaybe . withSystemTempFile "futhark-input" $ \tmpf tmpf_h -> do
+    BS.hPutStr tmpf_h $ Bin.encode val
+    hClose tmpf_h
+    cmdRestore server tmpf [(v, t)]
+
+-- Frees the expression on error.
+scriptValueAsVars ::
+  (MonadError T.Text m, MonadIO m) =>
+  Server ->
+  [(VarName, TypeName)] ->
+  Script.ExpValue ->
+  m ()
+scriptValueAsVars server names_and_types val
+  | vals <- unCompound val,
+    length names_and_types == length vals,
+    Just loads <- zipWithM f names_and_types vals =
+    sequence_ loads
+  where
+    f (v, t0) (ValueAtom (Script.SValue t1 sval))
+      | t0 == t1 =
+        Just $ case sval of
+          Script.VVar oldname ->
+            cmdMaybe $ cmdRename server oldname v
+          Script.VVal sval' ->
+            valueAsVar server v t0 sval'
+    f _ _ = Nothing
+scriptValueAsVars server names_and_types val = do
+  cmdMaybe $ cmdFree server $ S.toList $ Script.serverVarsInValue val
+  throwError $
+    "Expected value of type: "
+      <> prettyTextOneLine (mkCompound (map snd names_and_types))
+      <> "\nBut got value of type:  "
+      <> prettyTextOneLine (fmap Script.scriptValueType val)
+      <> notes
+  where
+    notes = mconcat $ mapMaybe note names_and_types
+    note (_, t)
+      | "(" `T.isPrefixOf` t =
+        Just $
+          "\nNote: expected type " <> prettyText t <> " is an opaque tuple that cannot be constructed\n"
+            <> "in FutharkScript.  Consider using type annotations to give it a proper name."
+      | "{" `T.isPrefixOf` t =
+        Just $
+          "\nNote: expected type " <> prettyText t <> " is an opaque record that cannot be constructed\n"
+            <> "in FutharkScript.  Consider using type annotations to give it a proper name."
+      | otherwise =
+        Nothing
+
+-- | Make the provided 'Values' available as server-side variables.
+-- This may involve arbitrary server-side computation.  Error
+-- detection... dubious.
+valuesAsVars ::
+  (MonadError T.Text m, MonadIO m) =>
+  Server ->
+  [(VarName, TypeName)] ->
   FutharkExe ->
   FilePath ->
   Values ->
-  (FilePath -> IO a) ->
-  m a
-withValuesFile _ dir (InFile file) f
-  | takeExtension file /= ".gz" =
-    liftIO $ f $ dir </> file
-withValuesFile futhark dir vs f =
-  liftIO . withSystemTempFile "futhark-input" $ \tmpf tmpf_h -> do
-    mapM_ (BS.hPutStr tmpf_h . Bin.encode) =<< getValues futhark dir vs
+  m ()
+valuesAsVars server names_and_types _ dir (InFile file)
+  | takeExtension file == ".gz" = do
+    s <- liftIO $ readAndDecompress $ dir </> file
+    case s of
+      Left e ->
+        throwError $ T.pack $ show file <> ": " <> show e
+      Right s' ->
+        cmdMaybe . withSystemTempFile "futhark-input" $ \tmpf tmpf_h -> do
+          BS.hPutStr tmpf_h s'
+          hClose tmpf_h
+          cmdRestore server tmpf names_and_types
+  | otherwise =
+    cmdMaybe $ cmdRestore server (dir </> file) names_and_types
+valuesAsVars server names_and_types futhark dir (GenValues gens) = do
+  unless (length gens == length names_and_types) $
+    throwError "Mismatch between number of expected and generated values."
+  gen_fs <- mapM (getGenFile futhark dir) gens
+  forM_ (zip gen_fs names_and_types) $ \(file, (v, t)) ->
+    cmdMaybe $ cmdRestore server (dir </> file) [(v, t)]
+valuesAsVars server names_and_types _ _ (Values vs) = do
+  unless (length vs == length names_and_types) $
+    throwError "Mismatch between number of expected and provided values."
+  cmdMaybe . withSystemTempFile "futhark-input" $ \tmpf tmpf_h -> do
+    mapM_ (BS.hPutStr tmpf_h . Bin.encode) vs
     hClose tmpf_h
-    f tmpf
-
--- | Check that the file contains values of the expected types.
-checkValueTypes ::
-  (MonadError T.Text m, MonadIO m) => FilePath -> [TypeName] -> m ()
-checkValueTypes values_f input_types = do
-  maybe_vs <- liftIO $ readValues <$> BS.readFile values_f
-  case maybe_vs of
-    Nothing ->
-      throwError "Invalid input data format."
-    Just vs -> do
-      let vs_types = map (prettyValueTypeNoDims . valueType) vs
-      unless (vs_types == input_types) $
-        throwError $
-          T.unlines
-            [ "Expected input types: " <> T.unwords input_types,
-              "Provided input types: " <> T.unwords vs_types
-            ]
+    cmdRestore server tmpf names_and_types
+valuesAsVars server names_and_types _ _ (ScriptValues e) =
+  Script.withScriptServer' server $ \server' -> do
+    e_v <- Script.evalExp noBuiltin server' e
+    scriptValueAsVars server names_and_types e_v
+  where
+    noBuiltin f _ = do
+      throwError $ "Unknown builtin procedure: " <> f
+valuesAsVars server names_and_types futhark dir (ScriptFile f) = do
+  e <-
+    either (throwError . T.pack . errorBundlePretty) pure
+      . parse (Script.parseExp space) f
+      =<< liftIO (T.readFile (dir </> f))
+  valuesAsVars server names_and_types futhark dir (ScriptValues e)
 
 -- | There is a risk of race conditions when multiple programs have
 -- identical 'GenValues'.  In such cases, multiple threads in 'futhark
@@ -558,8 +656,8 @@
 -- approach here seems robust enough for now, but certainly it could
 -- be made even better.  The race condition that remains should mostly
 -- result in duplicate work, not crashes or data corruption.
-getGenBS :: MonadIO m => FutharkExe -> FilePath -> GenValue -> m BS.ByteString
-getGenBS futhark dir gen = do
+getGenFile :: MonadIO m => FutharkExe -> FilePath -> GenValue -> m FilePath
+getGenFile futhark dir gen = do
   liftIO $ createDirectoryIfMissing True $ dir </> "data"
   exists_and_proper_size <-
     liftIO $
@@ -575,9 +673,12 @@
         hClose h -- We will be writing and reading this ourselves.
         SBS.writeFile tmpfile s
         renameFile tmpfile $ dir </> file
-  getValuesBS futhark dir $ InFile file
+  pure file
   where
     file = "data" </> genFileName gen
+
+getGenBS :: MonadIO m => FutharkExe -> FilePath -> GenValue -> m BS.ByteString
+getGenBS futhark dir gen = liftIO . BS.readFile . (dir </>) =<< getGenFile futhark dir gen
 
 genValues :: FutharkExe -> [GenValue] -> IO SBS.ByteString
 genValues (FutharkExe futhark) gens = do
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
@@ -27,6 +27,7 @@
     -- * Manipulating values
     valueElems,
     mkCompound,
+    unCompound,
 
     -- * Comparing Values
     compareValues,
@@ -47,6 +48,7 @@
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import Data.Char (chr, isSpace, ord)
 import Data.Int (Int16, Int32, Int64, Int8)
+import Data.List (intercalate)
 import qualified Data.Map as M
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -58,6 +60,8 @@
 import qualified Data.Vector.Unboxed.Mutable as UMVec
 import Futhark.IR.Primitive (PrimValue)
 import Futhark.IR.Prop.Constants (IsValue (..))
+import Futhark.IR.Prop.Reshape (unflattenIndex)
+import Futhark.Util.IntegralExp
 import Futhark.Util.Loc (Pos (..))
 import Futhark.Util.Pretty
 import qualified Futhark.Util.Pretty as PP
@@ -227,6 +231,12 @@
 mkCompound [v] = ValueAtom v
 mkCompound vs = ValueTuple $ map ValueAtom vs
 
+-- | If the value is a tuple, extract the components, otherwise return
+-- a singleton list of the value.
+unCompound :: Compound v -> [Compound v]
+unCompound (ValueTuple vs) = vs
+unCompound v = [v]
+
 -- | Like a 'Value', but also grouped in compound ways that are not
 -- supported by raw values.  You cannot parse or read these in
 -- standard ways, and they cannot be elements of arrays.
@@ -602,25 +612,27 @@
 data Mismatch
   = -- | The position the value number and a flat index
     -- into the array.
-    PrimValueMismatch (Int, Int) PrimValue PrimValue
+    PrimValueMismatch Int [Int] PrimValue PrimValue
   | ArrayShapeMismatch Int [Int] [Int]
   | TypeMismatch Int String String
   | ValueCountMismatch Int Int
 
 instance Show Mismatch where
-  show (PrimValueMismatch (i, j) got expected) =
-    explainMismatch (i, j) "" got expected
+  show (PrimValueMismatch vi [] got expected) =
+    explainMismatch (show vi) "" got expected
+  show (PrimValueMismatch vi js got expected) =
+    explainMismatch (show vi ++ " index [" ++ intercalate "," (map show js) ++ "]") "" got expected
   show (ArrayShapeMismatch i got expected) =
-    explainMismatch i "array of shape " got expected
+    explainMismatch (show i) "array of shape " got expected
   show (TypeMismatch i got expected) =
-    explainMismatch i "value of type " got expected
+    explainMismatch (show i) "value of type " got expected
   show (ValueCountMismatch got expected) =
     "Expected " ++ show expected ++ " values, got " ++ show got
 
 -- | A human-readable description of how two values are not the same.
-explainMismatch :: (Show i, PP.Pretty a) => i -> String -> a -> a -> String
+explainMismatch :: (PP.Pretty a) => String -> String -> a -> a -> String
 explainMismatch i what got expected =
-  "Value " ++ show i ++ " expected " ++ what ++ PP.pretty expected ++ ", got " ++ PP.pretty got
+  "Value #" ++ i ++ ": expected " ++ what ++ PP.pretty expected ++ ", got " ++ PP.pretty got
 
 -- | Compare two sets of Futhark values for equality.  Shapes and
 -- types must also match.
@@ -663,6 +675,9 @@
   | otherwise =
     [ArrayShapeMismatch i (valueShape got_v) (valueShape expected_v)]
   where
+    unflatten =
+      map wrappedValue . unflattenIndex (map Wrapped (valueShape got_v)) . Wrapped
+
     {-# INLINE compareGen #-}
     {-# INLINE compareNum #-}
     {-# INLINE compareFloat #-}
@@ -686,7 +701,7 @@
 
     compareElement tol j got expected
       | comparePrimValue tol got expected = Nothing
-      | otherwise = Just $ PrimValueMismatch (i, j) (value got) (value expected)
+      | otherwise = Just $ PrimValueMismatch i (unflatten j) (value got) (value expected)
 
     compareFloatElement tol j got expected
       | isNaN got,
@@ -701,7 +716,7 @@
 
     compareBool j got expected
       | got == expected = Nothing
-      | otherwise = Just $ PrimValueMismatch (i, j) (value got) (value expected)
+      | otherwise = Just $ PrimValueMismatch i (unflatten j) (value got) (value expected)
 
 comparePrimValue ::
   (Ord num, Num num) =>
diff --git a/src/Futhark/Transform/FirstOrderTransform.hs b/src/Futhark/Transform/FirstOrderTransform.hs
--- a/src/Futhark/Transform/FirstOrderTransform.hs
+++ b/src/Futhark/Transform/FirstOrderTransform.hs
@@ -237,9 +237,17 @@
           <$> newParam "stream_mapout" (toDecl t' Unique)
           <*> letSubExp "stream_mapout_scratch" scratch
 
-  let onType t@Acc {} = t `toDecl` Unique
-      onType t = t `toDecl` Nonunique
-      merge = zip (map (fmap onType) fold_params) nes ++ mapout_merge
+  -- We need to copy the neutral elements because they may be consumed
+  -- in the body of the Stream.
+  let copyIfArray se = do
+        se_t <- subExpType se
+        case (se_t, se) of
+          (Array {}, Var v) -> letSubExp (baseString v) $ BasicOp $ Copy v
+          _ -> pure se
+  nes' <- mapM copyIfArray nes
+
+  let onType t = t `toDecl` Unique
+      merge = zip (map (fmap onType) fold_params) nes' ++ mapout_merge
       merge_params = map fst merge
       mapout_params = map fst mapout_merge
 
@@ -251,30 +259,19 @@
     BasicOp $ SubExp $ intConst Int64 1
 
   loop_body <- runBodyBinder $
-    localScope
-      ( scopeOf loop_form
-          <> scopeOfFParams merge_params
-      )
-      $ do
-        let slice =
-              [DimSlice (Var i) (Var (paramName chunk_size_param)) (intConst Int64 1)]
-        forM_ (zip chunk_params arrs) $ \(p, arr) ->
-          letBindNames [paramName p] $
-            BasicOp $
-              Index arr $
-                fullSlice (paramType p) slice
+    localScope (scopeOf loop_form <> scopeOfFParams merge_params) $ do
+      let slice = [DimSlice (Var i) (Var (paramName chunk_size_param)) (intConst Int64 1)]
+      forM_ (zip chunk_params arrs) $ \(p, arr) ->
+        letBindNames [paramName p] . BasicOp . Index arr $
+          fullSlice (paramType p) slice
 
-        (res, mapout_res) <- splitAt (length nes) <$> bodyBind (lambdaBody lam)
+      (res, mapout_res) <- splitAt (length nes) <$> bodyBind (lambdaBody lam)
 
-        mapout_res' <- forM (zip mapout_params mapout_res) $ \(p, se) ->
-          letSubExp "mapout_res" $
-            BasicOp $
-              Update
-                (paramName p)
-                (fullSlice (paramType p) slice)
-                se
+      mapout_res' <- forM (zip mapout_params mapout_res) $ \(p, se) ->
+        letSubExp "mapout_res" . BasicOp $
+          Update (paramName p) (fullSlice (paramType p) slice) se
 
-        resultBodyM $ res ++ mapout_res'
+      resultBodyM $ res ++ mapout_res'
 
   letBind pat $ DoLoop [] merge loop_form loop_body
 transformSOAC pat (Scatter len lam ivs as) = do
@@ -287,24 +284,20 @@
   -- Scatter is in-place, so we use the input array as the output array.
   let merge = loopMerge asOuts $ map Var as_vs
   loopBody <- runBodyBinder $
-    localScope
-      ( M.insert iter (IndexName Int64) $
-          scopeOfFParams $ map fst merge
-      )
-      $ do
-        ivs' <- forM ivs $ \iv -> do
-          iv_t <- lookupType iv
-          letSubExp "write_iv" $ BasicOp $ Index iv $ fullSlice iv_t [DimFix $ Var iter]
-        ivs'' <- bindLambda lam (map (BasicOp . SubExp) ivs')
+    localScope (M.insert iter (IndexName Int64) $ scopeOfFParams $ map fst merge) $ do
+      ivs' <- forM ivs $ \iv -> do
+        iv_t <- lookupType iv
+        letSubExp "write_iv" $ BasicOp $ Index iv $ fullSlice iv_t [DimFix $ Var iter]
+      ivs'' <- bindLambda lam (map (BasicOp . SubExp) ivs')
 
-        let indexes = groupScatterResults (zip3 as_ws as_ns $ map identName asOuts) ivs''
+      let indexes = groupScatterResults (zip3 as_ws as_ns $ map identName asOuts) ivs''
 
-        ress <- forM indexes $ \(_, arr, indexes') -> do
-          let saveInArray arr' (indexCur, valueCur) =
-                letExp "write_out" =<< eWriteArray arr' (map eSubExp indexCur) (eSubExp valueCur)
+      ress <- forM indexes $ \(_, arr, indexes') -> do
+        let saveInArray arr' (indexCur, valueCur) =
+              letExp "write_out" =<< eWriteArray arr' (map eSubExp indexCur) (eSubExp valueCur)
 
-          foldM saveInArray arr indexes'
-        return $ resultBody (map Var ress)
+        foldM saveInArray arr indexes'
+      return $ resultBody (map Var ress)
   letBind pat $ DoLoop [] merge (ForLoop iter Int64 len []) loopBody
 transformSOAC pat (Hist len ops bucket_fun imgs) = do
   iter <- newVName "iter"
diff --git a/src/Futhark/TypeCheck.hs b/src/Futhark/TypeCheck.hs
--- a/src/Futhark/TypeCheck.hs
+++ b/src/Futhark/TypeCheck.hs
@@ -54,8 +54,10 @@
   )
 where
 
-import Control.Monad.RWS.Strict
+import Control.Monad.Reader
+import Control.Monad.State.Strict
 import Control.Parallel.Strategies
+import Data.Bifunctor (second)
 import Data.List (find, intercalate, isPrefixOf, sort)
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -276,14 +278,17 @@
     envContext :: [String]
   }
 
+data TState = TState
+  { stateNames :: Names,
+    stateCons :: Consumption
+  }
+
 -- | The type checker runs in this monad.
 newtype TypeM lore a
   = TypeM
-      ( RWST
-          (Env lore) -- Reader
-          Consumption -- Writer
-          Names -- State
-          (Either (TypeError lore)) -- Inner monad
+      ( ReaderT
+          (Env lore)
+          (StateT TState (Either (TypeError lore)))
           a
       )
   deriving
@@ -291,8 +296,7 @@
       Functor,
       Applicative,
       MonadReader (Env lore),
-      MonadWriter Consumption,
-      MonadState Names
+      MonadState TState
     )
 
 instance
@@ -308,13 +312,17 @@
   Env lore ->
   TypeM lore a ->
   Either (TypeError lore) (a, Consumption)
-runTypeM env (TypeM m) = evalRWST m env mempty
+runTypeM env (TypeM m) =
+  second stateCons <$> runStateT (runReaderT m env) (TState mempty mempty)
 
 bad :: ErrorCase lore -> TypeM lore a
 bad e = do
   messages <- asks envContext
-  TypeM $ lift $ Left $ Error (reverse messages) e
+  TypeM $ lift $ lift $ Left $ Error (reverse messages) e
 
+tell :: Consumption -> TypeM lore ()
+tell cons = modify $ \s -> s {stateCons = stateCons s <> cons}
+
 -- | Add information about what is being type-checked to the current
 -- context.  Liberal use of this combinator makes it easier to track
 -- type errors, as the strings are added to type errors signalled via
@@ -338,10 +346,10 @@
 -- the program, report a type error.
 bound :: VName -> TypeM lore ()
 bound name = do
-  already_seen <- gets $ nameIn name
+  already_seen <- gets $ nameIn name . stateNames
   when already_seen $
     bad $ TypeError $ "Name " ++ pretty name ++ " bound twice"
-  modify (<> oneName name)
+  modify $ \s -> s {stateNames = oneName name <> stateNames s}
 
 occur :: Occurences -> TypeM lore ()
 occur = tell . Consumption . filter (not . nullOccurence)
@@ -365,10 +373,14 @@
   occur [consumption $ namesFromList $ filter isArray $ namesToList als]
 
 collectOccurences :: TypeM lore a -> TypeM lore (a, Occurences)
-collectOccurences m = pass $ do
-  (x, c) <- listen m
-  o <- checkConsumption c
-  return ((x, o), const mempty)
+collectOccurences m = do
+  old <- gets stateCons
+  modify $ \s -> s {stateCons = mempty}
+  x <- m
+  new <- gets stateCons
+  modify $ \s -> s {stateCons = old}
+  o <- checkConsumption new
+  pure (x, o)
 
 checkOpWith ::
   (OpWithAliases (Op lore) -> TypeM lore ()) ->
@@ -381,13 +393,11 @@
 checkConsumption (Consumption os) = return os
 
 alternative :: TypeM lore a -> TypeM lore b -> TypeM lore (a, b)
-alternative m1 m2 = pass $ do
-  (x, c1) <- listen m1
-  (y, c2) <- listen m2
-  os1 <- checkConsumption c1
-  os2 <- checkConsumption c2
-  let usage = Consumption $ os1 `altOccurences` os2
-  return ((x, y), const usage)
+alternative m1 m2 = do
+  (x, os1) <- collectOccurences m1
+  (y, os2) <- collectOccurences m2
+  tell $ Consumption $ os1 `altOccurences` os2
+  pure (x, y)
 
 -- | Permit consumption of only the specified names.  If one of these
 -- names is consumed, the consumption will be rewritten to be a
diff --git a/src/Futhark/Util.hs b/src/Futhark/Util.hs
--- a/src/Futhark/Util.hs
+++ b/src/Futhark/Util.hs
@@ -39,6 +39,8 @@
     lgammaf,
     tgamma,
     tgammaf,
+    hypot,
+    hypotf,
     fromPOSIX,
     toPOSIX,
     trim,
@@ -277,6 +279,18 @@
 -- | The system-level @tgammaf()@ function.
 tgammaf :: Float -> Float
 tgammaf = c_tgammaf
+
+foreign import ccall "hypot" c_hypot :: Double -> Double -> Double
+
+foreign import ccall "hypotf" c_hypotf :: Float -> Float -> Float
+
+-- | The system-level @hypot@ function.
+hypot :: Double -> Double -> Double
+hypot = c_hypot
+
+-- | The system-level @hypotf@ function.
+hypotf :: Float -> Float -> Float
+hypotf = c_hypotf
 
 -- | Turn a POSIX filepath into a filepath for the native system.
 toPOSIX :: Native.FilePath -> Posix.FilePath
diff --git a/src/Language/Futhark.hs b/src/Language/Futhark.hs
--- a/src/Language/Futhark.hs
+++ b/src/Language/Futhark.hs
@@ -5,6 +5,7 @@
     module Language.Futhark.Pretty,
     Ident,
     DimIndex,
+    Slice,
     AppExp,
     Exp,
     Pattern,
@@ -35,6 +36,9 @@
 
 -- | An index with type information.
 type DimIndex = DimIndexBase Info VName
+
+-- | A slice with type information.
+type Slice = SliceBase Info VName
 
 -- | An expression with type information.
 type Exp = ExpBase Info VName
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
@@ -1752,7 +1752,13 @@
 
 interpretDec :: Ctx -> Dec -> F ExtOp Ctx
 interpretDec ctx d = do
-  env <- runEvalM (ctxImports ctx) $ evalDec (ctxEnv ctx) d
+  env <- runEvalM (ctxImports ctx) $ do
+    env <- evalDec (ctxEnv ctx) d
+    -- We need to extract any new existential sizes and add them as
+    -- ordinary bindings to the context, or we will not be able to
+    -- look up their values later.
+    sizes <- extSizeEnv
+    pure $ env <> sizes
   return ctx {ctxEnv = env}
 
 interpretImport :: Ctx -> (FilePath, Prog) -> F ExtOp Ctx
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
@@ -822,12 +822,12 @@
          | while Exp
            { While $2 }
 
-VarSlice :: { ((Name, SrcLoc), [UncheckedDimIndex], SrcLoc) }
+VarSlice :: { ((Name, SrcLoc), UncheckedSlice, SrcLoc) }
           : 'id[' DimIndices ']'
             { let L vloc (INDEXING v) = $1
               in ((v, vloc), $2, srcspan $1 $>) }
 
-QualVarSlice :: { ((QualName Name, SrcLoc), [UncheckedDimIndex], SrcLoc) }
+QualVarSlice :: { ((QualName Name, SrcLoc), UncheckedSlice, SrcLoc) }
               : VarSlice
                 { let ((v, vloc), y, loc) = $1 in ((qualName v, vloc), y, loc) }
               | 'qid[' DimIndices ']'
diff --git a/src/Language/Futhark/Prop.hs b/src/Language/Futhark/Prop.hs
--- a/src/Language/Futhark/Prop.hs
+++ b/src/Language/Futhark/Prop.hs
@@ -91,6 +91,7 @@
     UncheckedIdent,
     UncheckedTypeDecl,
     UncheckedDimIndex,
+    UncheckedSlice,
     UncheckedExp,
     UncheckedModExp,
     UncheckedSigExp,
@@ -1248,6 +1249,9 @@
 
 -- | An index with no type annotations.
 type UncheckedDimIndex = DimIndexBase NoInfo Name
+
+-- | A slice with no type annotations.
+type UncheckedSlice = SliceBase NoInfo Name
 
 -- | An expression with no type annotations.
 type UncheckedExp = ExpBase NoInfo Name
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
@@ -53,6 +53,7 @@
     IdentBase (..),
     Inclusiveness (..),
     DimIndexBase (..),
+    SliceBase,
     SizeBinder (..),
     AppExpBase (..),
     AppRes (..),
@@ -646,6 +647,9 @@
 
 deriving instance Ord (DimIndexBase NoInfo VName)
 
+-- | A slicing of an array (potentially multiple dimensions).
+type SliceBase f vn = [DimIndexBase f vn]
+
 -- | A name qualified with a breadcrumb of module accesses.
 data QualName vn = QualName
   { qualQuals :: ![vn],
@@ -738,11 +742,11 @@
   | LetWith
       (IdentBase f vn)
       (IdentBase f vn)
-      [DimIndexBase f vn]
+      (SliceBase f vn)
       (ExpBase f vn)
       (ExpBase f vn)
       SrcLoc
-  | Index (ExpBase f vn) [DimIndexBase f vn] SrcLoc
+  | Index (ExpBase f vn) (SliceBase f vn) SrcLoc
   | -- | A match expression.
     Match (ExpBase f vn) (NE.NonEmpty (CaseBase f vn)) SrcLoc
 
@@ -813,7 +817,7 @@
     Assert (ExpBase f vn) (ExpBase f vn) (f String) SrcLoc
   | -- | An n-ary value constructor.
     Constr Name [ExpBase f vn] (f PatternType) SrcLoc
-  | Update (ExpBase f vn) [DimIndexBase f vn] (ExpBase f vn) SrcLoc
+  | Update (ExpBase f vn) (SliceBase f vn) (ExpBase f vn) SrcLoc
   | RecordUpdate (ExpBase f vn) [Name] (ExpBase f vn) (f PatternType) SrcLoc
   | Lambda
       [PatternBase f vn]
@@ -842,7 +846,7 @@
   | -- | Field projection as a section: @(.x.y.z)@.
     ProjectSection [Name] (f PatternType) SrcLoc
   | -- | Array indexing as a section: @(.[i,j])@.
-    IndexSection [DimIndexBase f vn] (f PatternType) SrcLoc
+    IndexSection (SliceBase f vn) (f PatternType) SrcLoc
   | -- | Type ascription: @e : t@.
     Ascript (ExpBase f vn) (TypeDeclBase f vn) SrcLoc
   | AppExp (AppExpBase f vn) (f AppRes)
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
@@ -21,9 +21,8 @@
 where
 
 import Control.Monad.Except
-import Control.Monad.RWS hiding (Sum)
+import Control.Monad.Reader
 import Control.Monad.State
-import Control.Monad.Writer hiding (Sum)
 import Data.Bifunctor
 import Data.Bitraversable
 import Data.Char (isAscii)
@@ -346,24 +345,17 @@
     -- This happens for function arguments that are
     -- not constants or names.
     stateDimTable :: M.Map SizeSource VName,
-    stateNames :: M.Map VName NameReason
+    stateNames :: M.Map VName NameReason,
+    stateOccs :: Occurences
   }
 
 newtype TermTypeM a
-  = TermTypeM
-      ( RWST
-          TermEnv
-          Occurences
-          TermTypeState
-          TypeM
-          a
-      )
+  = TermTypeM (ReaderT TermEnv (StateT TermTypeState TypeM) a)
   deriving
     ( Monad,
       Functor,
       Applicative,
       MonadReader TermEnv,
-      MonadWriter Occurences,
       MonadState TermTypeState,
       MonadError TypeError
     )
@@ -432,10 +424,13 @@
             termChecking = Nothing,
             termLevel = 0
           }
-  evalRWST m initial_tenv $ TermTypeState mempty 0 mempty mempty
+  second stateOccs
+    <$> runStateT
+      (runReaderT m initial_tenv)
+      (TermTypeState mempty 0 mempty mempty mempty)
 
 liftTypeM :: TypeM a -> TermTypeM a
-liftTypeM = TermTypeM . lift
+liftTypeM = TermTypeM . lift . lift
 
 localScope :: (TermScope -> TermScope) -> TermTypeM a -> TermTypeM a
 localScope f = local $ \tenv -> tenv {termScope = f $ termScope tenv}
@@ -997,10 +992,11 @@
 
     -- Collect and remove all occurences in @bnds@.  This relies
     -- on the fact that no variables shadow any other.
-    collectBindingsOccurences m = pass $ do
-      (x, usage) <- listen m
+    collectBindingsOccurences m = do
+      (x, usage) <- collectOccurences m
       let (relevant, rest) = split usage
-      return ((x, relevant), const rest)
+      occur rest
+      pure (x, relevant)
       where
         split =
           unzip
@@ -1137,11 +1133,11 @@
 
 sliceShape ::
   Maybe (SrcLoc, Rigidity) ->
-  [DimIndex] ->
+  Slice ->
   TypeBase (DimDecl VName) as ->
   TermTypeM (TypeBase (DimDecl VName) as, [VName])
 sliceShape r slice t@(Array als u et (ShapeDecl orig_dims)) =
-  runWriterT $ setDims <$> adjustDims slice orig_dims
+  runStateT (setDims <$> adjustDims slice orig_dims) []
   where
     setDims [] = stripArray (length orig_dims) t
     setDims dims' = Array als u et $ ShapeDecl dims'
@@ -1162,7 +1158,7 @@
             lift $
               extSize loc $
                 SourceSlice orig_d' (bareExp <$> i) (bareExp <$> j) (bareExp <$> stride)
-          tell $ maybeToList ext
+          modify (maybeToList ext ++)
           return d
         Just (loc, Nonrigid) ->
           lift $ NamedDim . qualName <$> newDimVar loc Nonrigid "slice_dim"
@@ -1610,16 +1606,16 @@
                 loc
             )
             (Info $ AppRes body_t ext)
-checkExp (AppExp (LetWith dest src idxes ve body loc) _) =
+checkExp (AppExp (LetWith dest src slice ve body loc) _) =
   sequentially (checkIdent src) $ \src' _ -> do
-    (t, _) <- newArrayType (srclocOf src) "src" $ length idxes
+    slice' <- checkSlice slice
+    (t, _) <- newArrayType (srclocOf src) "src" $ sliceDims slice'
     unify (mkUsage loc "type of target array") t $ toStruct $ unInfo $ identType src'
 
     -- Need the fully normalised type here to get the proper aliasing information.
     src_t <- normTypeFully $ unInfo $ identType src'
 
-    idxes' <- mapM checkDimIndex idxes
-    (elemt, _) <- sliceShape (Just (loc, Nonrigid)) idxes' =<< normTypeFully t
+    (elemt, _) <- sliceShape (Just (loc, Nonrigid)) slice' =<< normTypeFully t
 
     unless (unique src_t) $
       typeError loc mempty $
@@ -1647,11 +1643,11 @@
         (body_t, ext) <-
           unscopeType loc (M.singleton (identName dest') dest')
             =<< expTypeFully body'
-        return $ AppExp (LetWith dest' src' idxes' ve' body' loc) (Info $ AppRes body_t ext)
-checkExp (Update src idxes ve loc) = do
-  (t, _) <- newArrayType (srclocOf src) "src" $ length idxes
-  idxes' <- mapM checkDimIndex idxes
-  (elemt, _) <- sliceShape (Just (loc, Nonrigid)) idxes' =<< normTypeFully t
+        return $ AppExp (LetWith dest' src' slice' ve' body' loc) (Info $ AppRes body_t ext)
+checkExp (Update src slice ve loc) = do
+  slice' <- checkSlice slice
+  (t, _) <- newArrayType (srclocOf src) "src" $ sliceDims slice'
+  (elemt, _) <- sliceShape (Just (loc, Nonrigid)) slice' =<< normTypeFully t
 
   sequentially (checkExp ve >>= unifies "type of target array" elemt) $ \ve' _ ->
     sequentially (checkExp src >>= unifies "type of target array" t) $ \src' _ -> do
@@ -1667,7 +1663,7 @@
       unless (S.null $ src_als `S.intersection` aliases ve_t) $ badLetWithValue src ve loc
 
       consume loc src_als
-      return $ Update src' idxes' ve' loc
+      return $ Update src' slice' ve' loc
 
 -- Record updates are a bit hacky, because we do not have row typing
 -- (yet?).  For now, we only permit record updates where we know the
@@ -1699,20 +1695,20 @@
           </> textwrap " is not known at this point.  Add a size annotation to the original record to disambiguate."
 
 --
-checkExp (AppExp (Index e idxes loc) _) = do
-  (t, _) <- newArrayType loc "e" $ length idxes
+checkExp (AppExp (Index e slice loc) _) = do
+  slice' <- checkSlice slice
+  (t, _) <- newArrayType loc "e" $ sliceDims slice'
   e' <- unifies "being indexed at" t =<< checkExp e
-  idxes' <- mapM checkDimIndex idxes
   -- XXX, the RigidSlice here will be overridden in sliceShape with a proper value.
   (t', retext) <-
-    sliceShape (Just (loc, Rigid (RigidSlice Nothing ""))) idxes'
+    sliceShape (Just (loc, Rigid (RigidSlice Nothing ""))) slice'
       =<< expTypeFully e'
 
   -- Remove aliases if the result is an overloaded type, because that
   -- will certainly not be aliased.
   t'' <- noAliasesIfOverloaded t'
 
-  return $ AppExp (Index e' idxes' loc) (Info $ AppRes t'' retext)
+  return $ AppExp (Index e' slice' loc) (Info $ AppRes t'' retext)
 checkExp (Assert e1 e2 NoInfo loc) = do
   e1' <- require "being asserted" [Bool] =<< checkExp e1
   e2' <- checkExp e2
@@ -1819,11 +1815,11 @@
   let usage = mkUsage loc "projection at"
   b <- foldM (flip $ mustHaveField usage) a fields
   return $ ProjectSection fields (Info $ Scalar $ Arrow mempty Unnamed a b) loc
-checkExp (IndexSection idxes NoInfo loc) = do
-  (t, _) <- newArrayType loc "e" $ length idxes
-  idxes' <- mapM checkDimIndex idxes
-  (t', _) <- sliceShape Nothing idxes' t
-  return $ IndexSection idxes' (Info $ fromStruct $ Scalar $ Arrow mempty Unnamed t t') loc
+checkExp (IndexSection slice NoInfo loc) = do
+  slice' <- checkSlice slice
+  (t, _) <- newArrayType loc "e" $ sliceDims slice'
+  (t', _) <- sliceShape Nothing slice' t
+  return $ IndexSection slice' (Info $ fromStruct $ Scalar $ Arrow mempty Unnamed t t') loc
 checkExp (AppExp (DoLoop _ mergepat mergeexp form loopbody loc) _) =
   sequentially (checkExp mergeexp) $ \mergeexp' _ -> do
     zeroOrderType
@@ -1897,12 +1893,12 @@
                       | d' == d ->
                         return $ Just (qualLeaf v, SizeSubst d)
                     _ -> do
-                      tell [qualLeaf v]
+                      modify (qualLeaf v :)
                       return Nothing
               mismatchSubst _ = return Nothing
 
               (init_substs', sparams) =
-                runWriter $
+                (`runState` mempty) $
                   M.fromList . catMaybes
                     <$> mapM
                       mismatchSubst
@@ -2252,16 +2248,23 @@
   (QualName _ name', vt) <- lookupVar loc (qualName name)
   return $ Ident name' (Info vt) loc
 
-checkDimIndex :: DimIndexBase NoInfo Name -> TermTypeM DimIndex
-checkDimIndex (DimFix i) =
-  DimFix <$> (require "use as index" anySignedType =<< checkExp i)
-checkDimIndex (DimSlice i j s) =
-  DimSlice <$> check i <*> check j <*> check s
+checkSlice :: UncheckedSlice -> TermTypeM Slice
+checkSlice = mapM checkDimIndex
   where
+    checkDimIndex (DimFix i) =
+      DimFix <$> (require "use as index" anySignedType =<< checkExp i)
+    checkDimIndex (DimSlice i j s) =
+      DimSlice <$> check i <*> check j <*> check s
+
     check =
       maybe (return Nothing) $
         fmap Just . unifies "use as index" (Scalar $ Prim $ Signed Int64) <=< checkExp
 
+-- The number of dimensions affected by this slice (so the minimum
+-- rank of the array we are slicing).
+sliceDims :: Slice -> Int
+sliceDims = length
+
 sequentially :: TermTypeM a -> (a -> Occurences -> TermTypeM b) -> TermTypeM b
 sequentially m1 m2 = do
   (a, m1flow) <- collectOccurences m1
@@ -2533,6 +2536,9 @@
       onExp known (ProjectSection _ (Info t) loc)
         | Just bad <- checkCausality "projection section" known t loc =
           bad
+      onExp known (IndexSection _ (Info t) loc)
+        | Just bad <- checkCausality "projection section" known t loc =
+          bad
       onExp known (OpSectionRight _ (Info t) _ _ _ loc)
         | Just bad <- checkCausality "operator section" known t loc =
           bad
@@ -2988,11 +2994,14 @@
 -- Returns the sizes of the immediate type produced,
 -- the sizes of parameter types, and the sizes of return types.
 dimUses :: StructType -> (Names, Names, Names)
-dimUses = execWriter . traverseDims f
+dimUses = (`execState` mempty) . traverseDims f
   where
-    f _ PosImmediate (NamedDim v) = tell (S.singleton (qualLeaf v), mempty, mempty)
-    f _ PosParam (NamedDim v) = tell (mempty, S.singleton (qualLeaf v), mempty)
-    f _ PosReturn (NamedDim v) = tell (mempty, mempty, S.singleton (qualLeaf v))
+    f _ PosImmediate (NamedDim v) =
+      modify (<> (S.singleton (qualLeaf v), mempty, mempty))
+    f _ PosParam (NamedDim v) =
+      modify (<> (mempty, S.singleton (qualLeaf v), mempty))
+    f _ PosReturn (NamedDim v) =
+      modify (<> (mempty, mempty, S.singleton (qualLeaf v)))
     f _ _ _ = return ()
 
 -- | Find all type variables in the given type that are covered by the
@@ -3156,7 +3165,7 @@
 --- Consumption
 
 occur :: Occurences -> TermTypeM ()
-occur = tell
+occur occs = modify $ \s -> s {stateOccs = stateOccs s <> occs}
 
 -- | Proclaim that we have made read-only use of the given variable.
 observe :: Ident -> TermTypeM ()
@@ -3207,15 +3216,25 @@
       scope {scopeVtable = M.insert name (WasConsumed loc) $ scopeVtable scope}
 
 collectOccurences :: TermTypeM a -> TermTypeM (a, Occurences)
-collectOccurences m = pass $ do
-  (x, dataflow) <- listen m
-  return ((x, dataflow), const mempty)
+collectOccurences m = do
+  old <- gets stateOccs
+  modify $ \s -> s {stateOccs = mempty}
+  x <- m
+  new <- gets stateOccs
+  modify $ \s -> s {stateOccs = old}
+  pure (x, new)
 
 tapOccurences :: TermTypeM a -> TermTypeM (a, Occurences)
-tapOccurences = listen
+tapOccurences m = do
+  (x, occs) <- collectOccurences m
+  occur occs
+  pure (x, occs)
 
 removeSeminullOccurences :: TermTypeM a -> TermTypeM a
-removeSeminullOccurences = censor $ filter $ not . seminullOccurence
+removeSeminullOccurences m = do
+  (x, occs) <- collectOccurences m
+  occur $ filter (not . seminullOccurence) occs
+  pure x
 
 checkIfUsed :: Occurences -> Ident -> TermTypeM ()
 checkIfUsed occs v
@@ -3226,22 +3245,22 @@
     return ()
 
 alternative :: TermTypeM a -> TermTypeM b -> TermTypeM (a, b)
-alternative m1 m2 = pass $ do
-  (x, occurs1) <- listen $ noSizeEscape m1
-  (y, occurs2) <- listen $ noSizeEscape m2
+alternative m1 m2 = do
+  (x, occurs1) <- collectOccurences $ noSizeEscape m1
+  (y, occurs2) <- collectOccurences $ noSizeEscape m2
   checkOccurences occurs1
   checkOccurences occurs2
-  let usage = occurs1 `altOccurences` occurs2
-  return ((x, y), const usage)
+  occur $ occurs1 `altOccurences` occurs2
+  pure (x, y)
 
 -- | Enter a context where nothing outside can be consumed (i.e. the
 -- body of a function definition).
 noUnique :: TermTypeM a -> TermTypeM a
-noUnique m = pass $ do
-  (x, occs) <- listen $ localScope f m
+noUnique m = do
+  (x, occs) <- collectOccurences $ localScope f m
   checkOccurences occs
-  let (observations, _) = split occs
-  pure (x, const observations)
+  occur $ fst $ split occs
+  pure x
   where
     f scope = scope {scopeVtable = M.map set $ scopeVtable scope}
 
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
@@ -39,9 +39,7 @@
 where
 
 import Control.Monad.Except
-import Control.Monad.RWS.Strict hiding (Sum)
 import Control.Monad.State
-import Control.Monad.Writer hiding (Sum)
 import Data.Bifoldable (biany)
 import Data.Bifunctor
 import Data.Char (isAscii)
@@ -1067,12 +1065,12 @@
   TypeBase (DimDecl VName) as ->
   TypeBase (DimDecl VName) as ->
   (TypeBase (DimDecl VName) as, [(DimDecl VName, DimDecl VName)])
-anyDimOnMismatch t1 t2 = runWriter $ matchDims onDims t1 t2
+anyDimOnMismatch t1 t2 = runState (matchDims onDims t1 t2) []
   where
     onDims d1 d2
       | d1 == d2 = return d1
       | otherwise = do
-        tell [(d1, d2)]
+        modify ((d1, d2) :)
         return $ AnyDim undefined
 
 newDimOnMismatch ::