futhark 0.19.2 → 0.19.3

raw patch · 52 files changed

+623/−439 lines, 52 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• docs/c-api.rst +22/−13
• docs/man/futhark-literate.rst +19/−2
• docs/man/futhark.rst +2/−2
• futhark.cabal +1/−1
• prelude/zip.fut +6/−6
• rts/c/free_list.h +3/−0
• rts/c/server.h +40/−0
• rts/c/util.h +16/−9
• rts/python/scalar.py +1/−1
• rts/python/server.py +1/−1
• rts/python/values.py +1/−1
• src/Futhark/Analysis/HORep/SOAC.hs +16/−12
• src/Futhark/Bench.hs +6/−2
• src/Futhark/CLI/Autotune.hs +2/−2
• src/Futhark/CLI/Bench.hs +4/−3
• src/Futhark/CLI/Literate.hs +21/−4
• src/Futhark/CLI/Misc.hs +6/−7
• src/Futhark/CLI/Test.hs +6/−4
• src/Futhark/CodeGen/Backends/COpenCL.hs +2/−1
• src/Futhark/CodeGen/Backends/GenericC/Options.hs +1/−1
• src/Futhark/CodeGen/Backends/GenericC/Server.hs +5/−3
• src/Futhark/CodeGen/Backends/PyOpenCL.hs +1/−1
• src/Futhark/CodeGen/Backends/SimpleRep.hs +2/−2
• src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs +8/−9
• src/Futhark/Compiler/Program.hs +5/−17
• src/Futhark/IR/Kernels/Simplify.hs +1/−1
• src/Futhark/IR/Kernels/Sizes.hs +2/−3
• src/Futhark/IR/Parse.hs +12/−13
• src/Futhark/IR/Pretty.hs +7/−8
• src/Futhark/IR/SOACS/SOAC.hs +137/−92
• src/Futhark/IR/SOACS/Simplify.hs +37/−35
• src/Futhark/Internalise.hs +17/−14
• src/Futhark/Optimise/Fusion.hs +3/−3
• src/Futhark/Optimise/Fusion/LoopKernel.hs +12/−16
• src/Futhark/Optimise/Simplify/Rules/Simple.hs +32/−0
• src/Futhark/Optimise/TileLoops.hs +3/−3
• src/Futhark/Optimise/TileLoops/Shared.hs +1/−1
• src/Futhark/Pass/ExtractKernels.hs +17/−23
• src/Futhark/Pass/ExtractKernels/DistributeNests.hs +13/−17
• src/Futhark/Pass/ExtractKernels/ISRWIM.hs +5/−9
• src/Futhark/Pass/ExtractKernels/Interchange.hs +2/−2
• src/Futhark/Pass/ExtractKernels/Intragroup.hs +6/−12
• src/Futhark/Pass/ExtractMulticore.hs +7/−21
• src/Futhark/Pass/KernelBabysitting.hs +15/−10
• src/Futhark/Script.hs +31/−29
• src/Futhark/Test.hs +22/−3
• src/Futhark/Test/Values.hs +7/−0
• src/Futhark/Tools.hs +4/−4
• src/Futhark/Transform/FirstOrderTransform.hs +5/−12
• src/Futhark/TypeCheck.hs +11/−3
• src/Futhark/Util.hs +15/−0
• src/Language/Futhark/Prop.hs +2/−1

@@ -229,14 +229,20 @@    count by one.  The value (or at least this reference) may not be    used again after this function returns. -.. c:function:: int futhark_store_opaque_foo(struct futhark_context *ctx, const struct futhark_opaque_foo *obj, void **p, size_t *n);+.. c:function:: int futhark_store_opaque_foo(struct futhark_context *ctx, const struct futhark_opaque_foo *obj, void **p, size_t *n)     Serialise an opaque value to a byte sequence, which can later be    restored with :c:func:`futhark_restore_opaque_foo`.  The byte-   representation is not otherwise specified.  The variable pointed to-   by ``n`` will always be set to the number of bytes needed to-   represent the value.  The ``p`` parameter is more complex:+   representation is not otherwise specified, and is not stable+   between compiler versions or programs.  It is stable under change+   of compiler backend, but not change of compiler version, or+   modification to the source program (although in most cases the+   format will not change). +   The variable pointed to by ``n`` will always be set to the number+   of bytes needed to represent the value.  The ``p`` parameter is+   more complex:+    * If ``p`` is ``NULL``, the function will write to ``*n``, but not      actually serialise the opaque value. @@ -250,7 +256,7 @@     Returns 0 on success. -.. c:function:: struct futhark_opaque_foo* futhark_restore_opaque_foo(struct futhark_context *ctx, const void *p);+.. c:function:: struct futhark_opaque_foo* futhark_restore_opaque_foo(struct futhark_context *ctx, const void *p)     Restore a byte sequence previously written with    :c:func:`futhark_store_opaque_foo`.  Returns ``NULL`` on failure.@@ -277,16 +283,19 @@    sure to call :c:func:`futhark_context_sync` before using the value    of ``out0``. -The exact behaviour of the exit code depends on the backend.  For the-sequential C backend, errors will always be available when the entry-point returns, and :c:func:`futhark_context_sync` will always return-success.  When using a GPU backend such as ``cuda`` or ``opencl``, the-entry point may still be running asynchronous operations when it+Errors are indicated by a nonzero return value.  On error, nothing is+written to the *out*-parameters.++The precise semantics of the return value depends on the backend.  For+the sequential C backend, errors will always be available when the+entry point returns, and :c:func:`futhark_context_sync` will always+return zero.  When using a GPU backend such as ``cuda`` or ``opencl``,+the entry point may still be running asynchronous operations when it returns, in which case the entry point may return zero successfully, even though execution has already (or will) fail.  These problems will-be reported when :c:func:`futhark_context_sync` is called.  When using-GPU backends, be careful to check the return code of *both* the entry-point itself, and :c:func:`futhark_context_sync`.+be reported when :c:func:`futhark_context_sync` is called.  Therefore,+be careful to check the return code of *both* the entry point itself,+and :c:func:`futhark_context_sync`.  GPU ---

@@ -140,8 +140,25 @@  * ``> :img e`` -  Visualises ``e``, which must be of type ``[][]i32`` or ``[][]u32``-  (interpreted as rows of ARGB pixel values).+  Visualises ``e``. The following types are supported:++  * ``[][]i32`` and ``[][]u32``++    Interpreted as ARGB pixel values.++  * ``[][]f32`` and ``[][]f64``++    Interpreted as greyscale. Values should be between 0 and 1, with 0+    being black and 0 being white.++  * ``[][]u8``++    Interpreted as greyscale. 0 is black and 255 is white.++  * ``[][]bool``++    Interpreted as black and white. ``false`` is black and ``true`` is+    white.  * ``> :plot2d e[; size=(height,width)]`` 

@@ -57,8 +57,8 @@ futhark hash PROGRAM -------------------- -Print a hexadecimal hash of the program AST, including all imports.-Supposed to be invariant to whitespace changes.+Print a hexadecimal hash of the program AST, including all non-builtin+imports.  Supposed to be invariant to whitespace changes.  futhark imports PROGRAM -----------------------

@@ -1,7 +1,7 @@ cabal-version: 2.4 -- Run 'cabal2nix . >futhark.nix' after adding deps. name:           futhark-version:        0.19.2+version:        0.19.3 synopsis:       An optimising compiler for a functional, array-oriented language.  description:    Futhark is a small programming language designed to be compiled to

@@ -14,23 +14,23 @@   intrinsics.map (f, as) :> [n]x  -- | Construct an array of pairs from two arrays.-let zip [n] 'a 'b (as: [n]a) (bs: [n]b): [n](a,b) =-  intrinsics.zip (as, bs) :> [n](a,b)+let zip [n] 'a 'b (as: [n]a) (bs: [n]b): *[n](a,b) =+  intrinsics.zip (as, bs) :> *[n](a,b)  -- | Construct an array of pairs from two arrays.-let zip2 [n] 'a 'b (as: [n]a) (bs: [n]b): [n](a,b) =+let zip2 [n] 'a 'b (as: [n]a) (bs: [n]b): *[n](a,b) =   zip as bs :> [n](a,b)  -- | As `zip2`@term, but with one more array.-let zip3 [n] 'a 'b 'c (as: [n]a) (bs: [n]b) (cs: [n]c): [n](a,b,c) =+let zip3 [n] 'a 'b 'c (as: [n]a) (bs: [n]b) (cs: [n]c): *[n](a,b,c) =   internal_map (\(a,(b,c)) -> (a,b,c)) (zip as (zip2 bs cs))  -- | As `zip3`@term, but with one more array.-let zip4 [n] 'a 'b 'c 'd (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d): [n](a,b,c,d) =+let zip4 [n] 'a 'b 'c 'd (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d): *[n](a,b,c,d) =   internal_map (\(a,(b,c,d)) -> (a,b,c,d)) (zip as (zip3 bs cs ds))  -- | As `zip4`@term, but with one more array.-let zip5 [n] 'a 'b 'c 'd 'e (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d) (es: [n]e): [n](a,b,c,d,e) =+let zip5 [n] 'a 'b 'c 'd 'e (as: [n]a) (bs: [n]b) (cs: [n]c) (ds: [n]d) (es: [n]e): *[n](a,b,c,d,e) =   internal_map (\(a,(b,c,d,e)) -> (a,b,c,d,e)) (zip as (zip4 bs cs ds es))  -- | Turn an array of pairs into two arrays.

@@ -31,6 +31,9 @@   for (int i = 0; i < l->capacity; i++) {     if (l->entries[i].valid) {       l->entries[p] = l->entries[i];+      if (i > p) {+        l->entries[i].valid = 0;+      }       p++;     }   }

@@ -616,11 +616,51 @@   return aux->free(ctx, arr); } +typedef void* (*opaque_restore_fn)(struct futhark_context*, void*);+typedef int (*opaque_store_fn)(struct futhark_context*, const void*, void **, size_t *); typedef int (*opaque_free_fn)(struct futhark_context*, void*);  struct opaque_aux {+  opaque_restore_fn restore;+  opaque_store_fn store;   opaque_free_fn free; };++int restore_opaque(const struct opaque_aux *aux, FILE *f,+                   struct futhark_context *ctx, void *p) {+  // We have a problem: we need to load data from 'f', since the+  // restore function takes a pointer, but we don't know how much we+  // need (and cannot possibly).  So we do something hacky: we read+  // *all* of the file, pass all of the data to the restore function+  // (which doesn't care if there's extra at the end), then we compute+  // how much space the the object actually takes in serialised form+  // and rewind the file to that position.  The only downside is more IO.+  size_t start = ftell(f);+  size_t size;+  char *bytes = fslurp_file(f, &size);+  void *obj = aux->restore(ctx, bytes);+  free(bytes);+  if (obj != NULL) {+    *(void**)p = obj;+    size_t obj_size;+    (void)aux->store(ctx, obj, NULL, &obj_size);+    fseek(f, start+obj_size, SEEK_SET);+    return 0;+  } else {+    fseek(f, start, SEEK_SET);+    return 1;+  }+}++void store_opaque(const struct opaque_aux *aux, FILE *f,+                  struct futhark_context *ctx, void *p) {+  void *obj = *(void**)p;+  size_t obj_size;+  void *data = NULL;+  (void)aux->store(ctx, obj, &data, &obj_size);+  fwrite(data, sizeof(char), obj_size, f);+  free(data);+}  int free_opaque(const struct opaque_aux *aux,                  struct futhark_context *ctx, void *p) {

@@ -49,27 +49,34 @@ #define CHECK_ERR(err, msg...) check_err(err, 0, __func__, __LINE__, msg) #define CHECK_ERRNO(err, msg...) check_err(err, 1, __func__, __LINE__, msg) -// Read a file into a NUL-terminated string; returns NULL on error.-static void* slurp_file(const char *filename, size_t *size) {-  unsigned char *s;-  FILE *f = fopen(filename, "rb"); // To avoid Windows messing with linebreaks.-  if (f == NULL) return NULL;+// Read the rest of an open file into a NUL-terminated string; returns+// NULL on error.+static void* fslurp_file(FILE *f, size_t *size) {+  size_t start = ftell(f);   fseek(f, 0, SEEK_END);-  size_t src_size = ftell(f);-  fseek(f, 0, SEEK_SET);-  s = (unsigned char*) malloc(src_size + 1);+  size_t src_size = ftell(f)-start;+  fseek(f, start, SEEK_SET);+  unsigned char *s = (unsigned char*) malloc(src_size + 1);   if (fread(s, 1, src_size, f) != src_size) {     free(s);     s = NULL;   } else {     s[src_size] = '\0';   }-  fclose(f);    if (size) {     *size = src_size;   } +  return s;+}++// Read a file into a NUL-terminated string; returns NULL on error.+static void* slurp_file(const char *filename, size_t *size) {+  FILE *f = fopen(filename, "rb"); // To avoid Windows messing with linebreaks.+  if (f == NULL) return NULL;+  unsigned char *s = fslurp_file(f, size);+  fclose(f);   return s; } 

@@ -152,7 +152,7 @@   return np.int64(x)  def itob_T_bool(x):-  return np.bool(x)+  return bool(x)  def btoi_bool_i8(x):   return np.int8(x)

@@ -91,7 +91,7 @@                 # In case we are using the PyOpenCL backend, we first                 # need to convert OpenCL arrays to ordinary NumPy                 # arrays.  We do this in a nasty way.-                if isinstance(value, np.number) or isinstance(value, np.bool) or isinstance(value, np.bool_) or isinstance(value, np.ndarray):+                if isinstance(value, np.number) or isinstance(value, bool) or isinstance(value, np.bool_) or isinstance(value, np.ndarray):                     # Ordinary NumPy value.                     f.write(construct_binary_value(self._vars[vname]))                 else:

@@ -478,7 +478,7 @@              'bin_reader': read_bin_bool,              'str_reader': read_str_bool,              'bin_format': 'b',-             'numpy_type': np.bool }+             'numpy_type': bool } }  def read_bin_read_type(f):

@@ -396,7 +396,7 @@         text "replicate" <> ppr cs <> PP.apply [ppr ne, e]  instance PrettyLore lore => PP.Pretty (SOAC lore) where-  ppr (Screma w form arrs) = Futhark.ppScrema w form arrs+  ppr (Screma w form arrs) = Futhark.ppScrema w arrs form   ppr (Hist len ops bucket_fun imgs) =     Futhark.ppHist len ops bucket_fun imgs   ppr soac = text $ show soac@@ -483,12 +483,12 @@   SOAC (Lore m) ->   m (Futhark.SOAC (Lore m)) toSOAC (Stream w form lam nes inps) =-  Futhark.Stream w form lam nes <$> inputsToSubExps inps+  Futhark.Stream w <$> inputsToSubExps inps <*> pure form <*> pure nes <*> pure lam toSOAC (Scatter len lam ivs dests) = do   ivs' <- inputsToSubExps ivs   return $ Futhark.Scatter len lam ivs' dests toSOAC (Screma w form arrs) =-  Futhark.Screma w form <$> inputsToSubExps arrs+  Futhark.Screma w <$> inputsToSubExps arrs <*> pure form toSOAC (Hist w ops lam inps) =   Futhark.Hist w ops lam <$> inputsToSubExps inps @@ -506,11 +506,11 @@   (Op lore ~ Futhark.SOAC lore, HasScope lore m) =>   Exp lore ->   m (Either NotSOAC (SOAC lore))-fromExp (Op (Futhark.Stream w form lam nes as)) =+fromExp (Op (Futhark.Stream w as form nes lam)) =   Right . Stream w form lam nes <$> traverse varInput as fromExp (Op (Futhark.Scatter len lam ivs as)) =   Right <$> (Scatter len lam <$> traverse varInput ivs <*> pure as)-fromExp (Op (Futhark.Screma w form arrs)) =+fromExp (Op (Futhark.Screma w arrs form)) =   Right . Screma w form <$> traverse varInput arrs fromExp (Op (Futhark.Hist w ops lam arrs)) =   Right . Hist w ops lam <$> traverse varInput arrs@@ -544,7 +544,9 @@         --         -- array result and input IDs of the stream's lambda         strm_resids <- mapM (newIdent "res") loutps-        let insoac = Futhark.Screma chvar (Futhark.mapSOAC lam') $ map paramName strm_inpids+        let insoac =+              Futhark.Screma chvar (map paramName strm_inpids) $+                Futhark.mapSOAC lam'             insbnd = mkLet [] strm_resids $ Op insoac             strmbdy = mkBody (oneStm insbnd) $ map (Futhark.Var . identName) strm_resids             strmpar = chunk_param : strm_inpids@@ -582,8 +584,8 @@         let insbnd =               mkLet [] (scan0_ids ++ map_resids) $                 Op $-                  Futhark.Screma chvar (Futhark.scanomapSOAC [Futhark.Scan scan_lam nes] lam') $-                    map paramName strm_inpids+                  Futhark.Screma chvar (map paramName strm_inpids) $+                    Futhark.scanomapSOAC [Futhark.Scan scan_lam nes] lam'             -- 2. let outerszm1id = chunksize - 1             outszm1bnd =               mkLet [] [outszm1id] $@@ -626,8 +628,10 @@         let mapbnd =               mkLet [] strm_resids $                 Op $-                  Futhark.Screma chvar (Futhark.mapSOAC maplam) $-                    map identName scan0_ids+                  Futhark.Screma+                    chvar+                    (map identName scan0_ids)+                    (Futhark.mapSOAC maplam)         -- 5. let acc'        = acc + lasteel_ids         addlelbdy <-           mkPlusBnds scan_lam $@@ -664,8 +668,8 @@         let insoac =               Futhark.Screma                 chvar-                (Futhark.redomapSOAC [Futhark.Reduce comm lamin nes] foldlam)-                $ map paramName strm_inpids+                (map paramName strm_inpids)+                $ Futhark.redomapSOAC [Futhark.Reduce comm lamin nes] foldlam             insbnd = mkLet [] (acc0_ids ++ strm_resids) $ Op insoac         -- 2. let acc'     = acc + acc0_ids    in         addaccbdy <-

@@ -166,8 +166,12 @@    cmdMaybe . liftIO $ cmdClear server -  cmdMaybe . liftIO . withValuesFile futhark dir input_spec $ \values_f ->-    cmdRestore server values_f (zip ins input_types)+  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)    let runtime l         | Just l' <- T.stripPrefix "runtime: " l,

@@ -194,11 +194,11 @@       map root $ filter (null . snd) thresholds   where     getThresholds = mapMaybe findThreshold . lines-    regex = makeRegex ("(.*)\\ \\(threshold\\ \\((.*)\\)\\)" :: String)+    regex = makeRegex ("(.*) \\(threshold\\(([^ ]+,)(.*)\\)\\)" :: String)      findThreshold :: String -> Maybe (String, [(String, Bool)])     findThreshold l = do-      [grp1, grp2] <- regexGroups regex l+      [grp1, _, grp2] <- regexGroups regex l       return         ( grp1,           filter (not . null . fst) $

@@ -192,7 +192,7 @@     mapM (forInputOutputs server tuning_desc) $ filter relevant cases   where     forInputOutputs server tuning_desc (InputOutputs entry_name runs) = do-      putStr $ inBold $ "\nResults for " ++ program' ++ tuning_desc ++ ":\n"+      putStr $ inBold $ "\n" ++ program' ++ tuning_desc ++ ":\n"       BenchResult program' . catMaybes         <$> mapM (runBenchmarkCase server opts futhark program entry_name pad_to) runs       where@@ -216,7 +216,7 @@  progressBar :: Int -> Int -> Int -> String progressBar cur bound steps =-  "[" ++ map cell [1 .. steps] ++ "] " ++ show cur ++ "/" ++ show bound+  "|" ++ map cell [1 .. steps] ++ "| " ++ show cur ++ "/" ++ show bound   where     step_size :: Double     step_size = fromIntegral bound / fromIntegral steps@@ -309,7 +309,8 @@    case res of     Left err -> do-      liftIO $ putStrLn $ descString dataset_desc pad_to+      when fancyTerminal $+        liftIO $ putStrLn $ descString dataset_desc pad_to       liftIO $ putStrLn $ inRed $ T.unpack err       return $ Just $ DataResult dataset_desc $ Left err     Right (runtimes, errout) -> do

@@ -163,12 +163,12 @@ parseInt = lexeme $ read <$> some (satisfy isDigit)  restOfLine :: Parser T.Text-restOfLine = takeWhileP Nothing (/= '\n') <* eol+restOfLine = takeWhileP Nothing (/= '\n') <* (void eol <|> eof)  parseBlockComment :: Parser T.Text parseBlockComment = T.unlines <$> some line   where-    line = ("-- " *> restOfLine) <|> ("--" *> eol $> "")+    line = "--" *> optional " " *> restOfLine  parseTestBlock :: Parser T.Text parseTestBlock =@@ -181,7 +181,7 @@ parseBlockCode = T.unlines . noblanks <$> some line   where     noblanks = reverse . dropWhile T.null . reverse . dropWhile T.null-    line = try (notFollowedBy "--") *> restOfLine+    line = try (notFollowedBy "--") *> notFollowedBy eof *> restOfLine  parsePlotParams :: Parser (Maybe (Int, Int)) parsePlotParams =@@ -314,6 +314,15 @@       let i' = round (i * 255) .&. 0xFF        in (i' `shiftL` 16) .|. (i' `shiftL` 8) .|. i' +greyByteToImg ::+  (Integral a, SVec.Storable a) =>+  SVec.Vector a ->+  SVec.Vector Word32+greyByteToImg = SVec.map grey+  where+    grey i =+      (fromIntegral i `shiftL` 16) .|. (fromIntegral i `shiftL` 8) .|. fromIntegral i+ -- BMPs are RGBA and bottom-up where we assumes images are top-down -- and ARGB.  We fix this up before encoding the BMP.  This is -- probably a little slower than it has to be.@@ -337,9 +346,15 @@ valueToBMP v@(Float32Value _ bytes)   | [h, w] <- valueShape v =     Just $ vecToBMP h w $ greyFloatToImg bytes+valueToBMP v@(Word8Value _ bytes)+  | [h, w] <- valueShape v =+    Just $ vecToBMP h w $ greyByteToImg bytes valueToBMP v@(Float64Value _ bytes)   | [h, w] <- valueShape v =     Just $ vecToBMP h w $ greyFloatToImg bytes+valueToBMP v@(BoolValue _ bytes)+  | [h, w] <- valueShape v =+    Just $ vecToBMP h w $ greyByteToImg $ SVec.map ((*) 255 . fromEnum) bytes valueToBMP _ = Nothing  valueToBMPs :: Value -> Maybe [LBS.ByteString]@@ -436,7 +451,7 @@ loadImage :: FilePath -> ScriptM (Compound Value) loadImage imgfile =   withTempDir $ \dir -> do-    let bmpfile = dir </> imgfile `replaceExtension` "bmp"+    let bmpfile = dir </> takeBaseName imgfile `replaceExtension` "bmp"     void $ system "convert" [imgfile, "-type", "TrueColorAlpha", bmpfile] mempty     loadBMP bmpfile @@ -835,6 +850,8 @@                 ++ scriptCompilerOptions opts         when (scriptVerbose opts > 0) $           T.hPutStrLn stderr $ "Compiling " <> T.pack prog <> "..."+        when (scriptVerbose opts > 1) $+          T.hPutStrLn stderr $ T.pack $ unwords compile_options          let onError err = do               mapM_ (T.hPutStrLn stderr) err

@@ -24,18 +24,17 @@ import System.FilePath import System.IO +isBuiltin :: String -> Bool+isBuiltin = ("prelude/" `isPrefixOf`)+ -- | @futhark imports@ mainImports :: String -> [String] -> IO () mainImports = mainWithOptions () [] "program" $ \args () ->   case args of     [file] -> Just $ do       (_, prog_imports, _) <- readProgramOrDie file-      liftIO $-        putStr $-          unlines $-            map (++ ".fut") $-              filter (\f -> not ("prelude/" `isPrefixOf` f)) $-                map fst prog_imports+      liftIO . putStr . unlines . map (++ ".fut") . filter (not . isBuiltin) $+        map fst prog_imports     _ -> Nothing  -- | @futhark hash@@@ -43,7 +42,7 @@ mainHash = mainWithOptions () [] "program" $ \args () ->   case args of     [file] -> Just $ do-      prog <- readUntypedProgramOrDie file+      prog <- filter (not . isBuiltin . fst) <$> readUntypedProgramOrDie file       liftIO $ T.putStrLn $ hashIntText $ hash $ prettyText prog     _ -> Nothing 

@@ -17,7 +17,6 @@ import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T import Futhark.Analysis.Metrics.Type import Futhark.Server import Futhark.Test@@ -295,8 +294,11 @@       context1 case_ctx $ do         expected <- getExpectedResult futhark program entry run -        (liftCommand . withValuesFile futhark dir inputValues) $ \values_f ->-          cmdRestore server values_f (zip ins input_types)+        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)          call_r <- liftIO $ cmdCall server entry outs ins         liftCommand $ cmdFree server ins@@ -550,7 +552,7 @@                 Failure s -> do                   when fancy moveCursorToTableTop                   clear-                  T.putStr $ (T.pack (inRed $ testCaseProgram test) <> ":\n") <> T.unlines s+                  putStr $ inBold (testCaseProgram test <> ":\n") <> T.unpack (T.unlines s)                   when fancy spaceTable                   getResults $                     ts'

@@ -25,6 +25,7 @@     GetSizeMax,   ) import Futhark.MonadFreshNames+import Futhark.Util.Pretty (prettyOneLine) import qualified Language.C.Quote.OpenCL as C import qualified Language.C.Syntax as C @@ -319,7 +320,7 @@   GC.stm [C.cstm|$id:v = ctx->sizes.$id:key <= $exp:x';|]   GC.stm     [C.cstm|if (ctx->logging) {-    fprintf(ctx->log, "Compared %s <= %ld: %s.\n", $string:(pretty key), (long)$exp:x', $id:v ? "true" : "false");+    fprintf(ctx->log, "Compared %s <= %ld: %s.\n", $string:(prettyOneLine key), (long)$exp:x', $id:v ? "true" : "false");     }|] callKernel (GetSizeMax v size_class) =   let field = "max_" ++ pretty size_class

@@ -61,7 +61,7 @@            futhark_panic(-1, "Missing argument for option %s\n", argv[optind-1]);          }          if ($id:chosen_option == '?') {-           fprintf(stderr, "Usage: %s: %s\n", fut_progname, $string:option_descriptions);+           fprintf(stderr, "Usage: %s [OPTIONS]...\nOptions:\n\n%s\n", fut_progname, $string:option_descriptions);            futhark_panic(1, "Unknown option: %s\n", argv[optind-1]);          }        }

@@ -44,7 +44,7 @@         optionDescription = "Print help information and exit.",         optionAction =           [C.cstm|{-                   printf("Usage: %s [OPTION]...\nOptions:\n\n%s\nFor more information, consult the Futhark User's Guide or the man pages.\n",+                   printf("Usage: %s [OPTIONS]...\nOptions:\n\n%s\nFor more information, consult the Futhark User's Guide or the man pages.\n",                           fut_progname, option_descriptions);                    exit(0);                   }|]@@ -165,12 +165,14 @@         ( [C.cinit|&$id:type_name|],           [C.cunit|               struct opaque_aux $id:aux_name = {+                .store = (typename opaque_store_fn)$id:opaque_store,+                .restore = (typename opaque_restore_fn)$id:opaque_restore,                 .free = (typename opaque_free_fn)$id:opaque_free               };               struct type $id:type_name = {                 .name = $string:name,-                .restore = (typename restore_fn)$id:opaque_store,-                .store = (typename store_fn)$id:opaque_restore,+                .restore = (typename restore_fn)restore_opaque,+                .store = (typename store_fn)store_opaque,                 .free = (typename free_fn)free_opaque,                 .aux = &$id:aux_name               };|]

@@ -185,7 +185,7 @@ -- We have many casts to 'long', because PyOpenCL may get confused at -- the 32-bit numbers that ImpCode uses for offsets and the like. asLong :: PyExp -> PyExp-asLong x = Py.simpleCall "np.long" [x]+asLong x = Py.simpleCall "np.int64" [x]  callKernel :: Py.OpCompiler Imp.OpenCL () callKernel (Imp.GetSize v key) = do

@@ -1097,7 +1097,7 @@ storeValueHeader sign pt rank shape dest =   [C.cstms|           *$exp:dest++ = 'b';-          *$exp:dest++ = 1;+          *$exp:dest++ = 2;           *$exp:dest++ = $int:rank;           memcpy($exp:dest, $string:(typeStr sign pt), 4);           $exp:dest += 4;@@ -1115,7 +1115,7 @@ loadValueHeader sign pt rank shape src =   [C.cstms|      err |= (*$exp:src++ != 'b');-     err |= (*$exp:src++ != 1);+     err |= (*$exp:src++ != 2);      err |= (*$exp:src++ != $exp:rank);      err |= (memcmp($exp:src, $string:(typeStr sign pt), 4) != 0);      $exp:src += 4;

@@ -179,7 +179,7 @@       dims' = map toInt64Exp dims       num_groups' = fmap toInt64Exp num_groups       group_size' = fmap toInt64Exp group_size-      global_tid = Imp.vi32 $ segFlat space+      global_tid = Imp.vi64 $ segFlat space       w = last dims'    counter <-@@ -472,7 +472,7 @@           constants           (zip gtids dims')           num_elements-          (sExt32 global_tid)+          global_tid           elems_per_thread           (tvVar threads_per_segment)           slugs@@ -598,7 +598,7 @@   KernelConstants ->   [(VName, Imp.TExp Int64)] ->   Imp.Count Imp.Elements (Imp.TExp Int64) ->-  Imp.TExp Int32 ->+  Imp.TExp Int64 ->   Imp.Count Imp.Elements (Imp.TExp Int64) ->   VName ->   [SegBinOpSlug] ->@@ -663,13 +663,12 @@     gtid       <-- case comm of         Commutative ->-          sExt64 global_tid-            + Imp.vi64 threads_per_segment * i+          global_tid + Imp.vi64 threads_per_segment * i         Noncommutative ->-          let index_in_segment = global_tid `quot` sExt32 (kernelGroupSize constants)+          let index_in_segment = global_tid `quot` kernelGroupSize constants            in sExt64 local_tid-                + (sExt64 index_in_segment * Imp.unCount elems_per_thread + i)-                * sExt64 (kernelGroupSize constants)+                + (index_in_segment * Imp.unCount elems_per_thread + i)+                * kernelGroupSize constants      check_bounds $       sComment "apply map function" $@@ -713,7 +712,7 @@   KernelConstants ->   [(VName, Imp.TExp Int64)] ->   Imp.Count Imp.Elements (Imp.TExp Int64) ->-  Imp.TExp Int32 ->+  Imp.TExp Int64 ->   Imp.Count Imp.Elements (Imp.TExp Int64) ->   VName ->   [SegBinOpSlug] ->

@@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}  -- | Low-level compilation parts.  Look at "Futhark.Compiler" for a -- more high-level API.@@ -16,16 +15,15 @@   ) where -import Control.Exception import Control.Monad import Control.Monad.Except import Control.Monad.State import Data.List (intercalate, isPrefixOf) import Data.Maybe import qualified Data.Text as T-import qualified Data.Text.IO as T import Futhark.Error import Futhark.FreshNames+import Futhark.Util (readFileSafely) import Futhark.Util.Pretty (line, ppr, (</>)) import qualified Language.Futhark as E import Language.Futhark.Parser@@ -34,18 +32,7 @@ import qualified Language.Futhark.TypeChecker as E import Language.Futhark.Warnings import qualified System.FilePath.Posix as Posix-import System.IO.Error -readFileSafely :: String -> IO (Maybe (Either String (String, T.Text)))-readFileSafely filepath =-  (Just . Right . (filepath,) <$> T.readFile filepath) `catch` couldNotRead-  where-    couldNotRead e-      | isDoesNotExistError e =-        return Nothing-      | otherwise =-        return $ Just $ Left $ show e- newtype ReaderState = ReaderState   {alreadyRead :: [(ImportName, E.UncheckedProg)]} @@ -66,9 +53,10 @@   -- First we try to find a file of the given name in the search path,   -- then we look at the builtin library if we have to.  For the   -- builtins, we don't use the search path.-  r <- liftIO $ readFileSafely $ includeToFilePath include+  let filepath = includeToFilePath include+  r <- liftIO $ readFileSafely filepath   case (r, lookup prelude_str prelude) of-    (Just (Right (filepath, s)), _) -> return (s, filepath)+    (Just (Right s), _) -> return (s, filepath)     (Just (Left e), _) -> externalErrorS e     (Nothing, Just t) -> return (t, prelude_str)     (Nothing, Nothing) -> externalErrorS not_found@@ -197,7 +185,7 @@     onFile fp = do       r <- liftIO $ readFileSafely fp       case r of-        Just (Right (_, fs)) ->+        Just (Right fs) ->           handleFile [] (mkInitialImport fp_name) fs fp         Just (Left e) -> externalErrorS e         Nothing -> externalErrorS $ fp ++ ": file not found."

@@ -105,7 +105,7 @@ -- around the fact that loop tiling would otherwise pointlessly tile -- them. redomapIotaToLoop :: TopDownRuleOp (Wise Kernels)-redomapIotaToLoop vtable pat aux (OtherOp soac@(Screma _ form [arr]))+redomapIotaToLoop vtable pat aux (OtherOp soac@(Screma _ [arr] form))   | Just _ <- isRedomapSOAC form,     Just (Iota {}, _) <- ST.lookupBasicOp arr vtable =     Simplify $ certifying (stmAuxCerts aux) $ FOT.transformSOAC pat soac

@@ -15,7 +15,6 @@   ) where -import Control.Category import Data.Int (Int64) import Data.Traversable import Futhark.IR.Prop.Names (FreeIn)@@ -47,11 +46,11 @@  instance Pretty SizeClass where   ppr (SizeThreshold path def) =-    "threshold(" <> ppr (map pStep path) <> def' <> ")"+    "threshold" <> parens (def' <> comma <+> spread (map pStep path))     where       pStep (v, True) = ppr v       pStep (v, False) = "!" <> ppr v-      def' = maybe mempty ((", " <>) . ppr) def+      def' = maybe "def" ppr def   ppr SizeGroup = text "group_size"   ppr SizeNumGroups = text "num_groups"   ppr SizeTile = text "tile_size"

@@ -514,8 +514,8 @@       parens $         SOAC.Screma           <$> pSubExp <* pComma-          <*> p <* pComma-          <*> (pVName `sepBy` pComma)+          <*> braces (pVName `sepBy` pComma) <* pComma+          <*> p     pScremaForm =       SOAC.ScremaForm         <$> braces (pScan pr `sepBy` pComma) <* pComma@@ -572,20 +572,20 @@       parens $         SOAC.Stream           <$> pSubExp <* pComma+          <*> braces (pVName `sepBy` pComma) <* pComma           <*> pParForm order comm <* pComma-          <*> pLambda pr <* pComma-          <*> braces (pSubExp `sepBy` pComma)-          <*> many (pComma *> pVName)+          <*> braces (pSubExp `sepBy` pComma) <* pComma+          <*> pLambda pr     pParForm order comm =       SOAC.Parallel order comm <$> pLambda pr     pStreamSeq =       parens $         SOAC.Stream           <$> pSubExp <* pComma+          <*> braces (pVName `sepBy` pComma) <* pComma           <*> pure SOAC.Sequential-          <*> pLambda pr <* pComma-          <*> braces (pSubExp `sepBy` pComma)-          <*> many (pComma *> pVName)+          <*> braces (pSubExp `sepBy` pComma) <* pComma+          <*> pLambda pr  pSizeClass :: Parser Kernel.SizeClass pSizeClass =@@ -598,16 +598,15 @@       keyword "local_memory" $> Kernel.SizeLocalMemory,       keyword "threshold"         *> parens-          ( Kernel.SizeThreshold-              <$> pKernelPath-              <*> optional (pComma *> pInt64)+          ( flip Kernel.SizeThreshold+              <$> choice [Just <$> pInt64, "def" $> Nothing] <* pComma+              <*> pKernelPath           ),       keyword "bespoke"         *> parens (Kernel.SizeBespoke <$> pName <* pComma <*> pInt64)     ]   where-    pKernelPath =-      brackets $ pStep `sepBy` pComma+    pKernelPath = many pStep     pStep =       choice         [ lexeme "!" $> (,) <*> pName <*> pure False,

@@ -142,13 +142,12 @@           (_, ann) -> equals </> (stack ann </> ppr e)     where       linebreak = case e of-        DoLoop {} -> True-        Op {} -> True-        If {} -> True-        Apply {} -> True-        BasicOp ArrayLit {} -> False-        BasicOp Assert {} -> True-        _ -> False+        BasicOp BinOp {} -> False+        BasicOp CmpOp {} -> False+        BasicOp ConvOp {} -> False+        BasicOp UnOp {} -> False+        BasicOp SubExp {} -> False+        _ -> True        stmannot =         concat@@ -269,7 +268,7 @@       pprLoopVar (p, a) = ppr p <+> text "in" <+> ppr a  instance PrettyLore lore => Pretty (Lambda lore) where-  ppr (Lambda [] _ []) = text "nilFn"+  ppr (Lambda [] (Body _ stms []) []) | stms == mempty = text "nilFn"   ppr (Lambda params body rettype) =     text "\\" <> ppTuple' params       <+/> colon <+> ppTuple' rettype <+> text "->"

@@ -39,6 +39,9 @@     isMapSOAC,     ppScrema,     ppHist,+    groupScatterResults,+    groupScatterResults',+    splitScatterResults,      -- * Generic traversal     SOACMapper (..),@@ -51,6 +54,7 @@ import Control.Monad.Identity import Control.Monad.State.Strict import Control.Monad.Writer+import Data.Function ((&)) import Data.List (intersperse) import qualified Data.Map.Strict as M import Data.Maybe@@ -73,27 +77,44 @@  -- | A second-order array combinator (SOAC). data SOAC lore-  = Stream SubExp (StreamForm lore) (Lambda lore) [SubExp] [VName]-  | -- | @Scatter <cs> <length> <lambda> <original index and value arrays>@+  = Stream SubExp [VName] (StreamForm lore) [SubExp] (Lambda lore)+  | -- | @Scatter <length> <lambda> <inputs> <outputs>@     ---    -- <input/output arrays along with their sizes and number of-    -- values to write for that array>+    -- Scatter maps values from a set of input arrays to indices and values of a+    -- set of output arrays. It is able to write multiple values to multiple+    -- outputs each of which may have multiple dimensions.     ---    -- <length> is the length of each index array and value array, since they-    -- all must be the same length for any fusion to make sense.  If you have a-    -- list of index-value array pairs of different sizes, you need to use-    -- multiple writes instead.+    -- <inputs> is a list of input arrays, all having size <length>, elements of+    -- which are applied to the <lambda> function. For instance, if there are+    -- two arrays, <lambda> will get two values as input, one from each array.     ---    -- The lambda body returns the output in this manner:+    -- <outputs> specifies the result of the <lambda> and which arrays to write+    -- to. Each element of the list consists of a <VName> specifying which array+    -- to scatter to, a <Shape> describing the shape of that array, and an <Int>+    -- describing how many elements should be written to that array for each+    -- invocation of the <lambda>.     --+    -- <lambda> is a function that takes inputs from <inputs> and returns values+    -- according to the output-specification in <outputs>. It returns values in+    -- the following manner:+    --     --     [index_0, index_1, ..., index_n, value_0, value_1, ..., value_m]     ---    -- This must be consistent along all Scatter-related optimisations.+    -- For each output in <outputs>, <lambda> returns <i> * <j> index values and+    -- <j> output values, where <i> is the number of dimensions (rank) of the+    -- given output, and <j> is the number of output values written to the given+    -- output.     ---    -- Scatters can be multi-dimensional, so the number of index-values need not-    -- necessarily match the number of values. Instead, the number of indexes-    -- must match the sum of the ranks of the shapes in the destination array-    -- list.+    -- For example, given the following output specification:+    --+    --     [([x1, y1, z1], 2, arr1), ([x2, y2], 1, arr2)]+    --+    -- <lambda> will produce 6 (3 * 2) index values and 2 output values for+    -- <arr1>, and 2 (2 * 1) index values and 1 output value for+    -- arr2. Additionally, the results are grouped, so the first 6 index values+    -- will correspond to the first two output values, and so on. For this+    -- example, <lambda> should return a total of 11 values, 8 index values and+    -- 3 output values.     Scatter SubExp (Lambda lore) [VName] [(Shape, Int, VName)]   | -- | @Hist <length> <dest-arrays-and-ops> <bucket fun> <input arrays>@     --@@ -103,7 +124,7 @@     Hist SubExp [HistOp lore] (Lambda lore) [VName]   | -- | A combination of scan, reduction, and map.  The first     -- t'SubExp' is the size of the input arrays.-    Screma SubExp (ScremaForm lore) [VName]+    Screma SubExp [VName] (ScremaForm lore)   deriving (Eq, Ord, Show)  -- | Information about computing a single histogram.@@ -298,6 +319,55 @@   guard $ null reds   return map_lam +-- | @groupScatterResults <output specification> <results>@+--+-- Groups the index values and result values of <results> according to the+-- <output specification>.+--+-- This function is used for extracting and grouping the results of a+-- scatter. In the SOAC representation, the lambda inside a 'Scatter' returns+-- all indices and values as one big list. This function groups each value with+-- its corresponding indices (as determined by the 'Shape' of the output array).+--+-- The elements of the resulting list correspond to the shape and name of the+-- output parameters, in addition to a list of values written to that output+-- parameter, along with the array indices marking where to write them to.+--+-- See 'Scatter' for more information.+groupScatterResults :: [(Shape, Int, array)] -> [a] -> [(Shape, array, [([a], a)])]+groupScatterResults output_spec results =+  let (shapes, ns, arrays) = unzip3 output_spec+   in groupScatterResults' output_spec results+        & chunks ns+        & zip3 shapes arrays++-- | @groupScatterResults' <output specification> <results>@+--+-- Groups the index values and result values of <results> according to the+-- output specification. This is the simpler version of @groupScatterResults@,+-- which doesn't return any information about shapes or output arrays.+--+-- See 'groupScatterResults' for more information,+groupScatterResults' :: [(Shape, Int, array)] -> [a] -> [([a], a)]+groupScatterResults' output_spec results =+  let (indices, values) = splitScatterResults output_spec results+      (shapes, ns, _) = unzip3 output_spec+      chunk_sizes =+        concat $ zipWith (\shp n -> replicate n $ length shp) shapes ns+   in zip (chunks chunk_sizes indices) values++-- | @splitScatterResults <output specification> <results>@+--+-- Splits the results array into indices and values according to the output+-- specification.+--+-- See 'groupScatterResults' for more information.+splitScatterResults :: [(Shape, Int, array)] -> [a] -> ([a], [a])+splitScatterResults output_spec results =+  let (shapes, ns, _) = unzip3 output_spec+      num_indices = sum $ zipWith (*) ns $ map length shapes+   in splitAt num_indices results+ -- | Like 'Mapper', but just for 'SOAC's. data SOACMapper flore tlore m = SOACMapper   { mapOnSOACSubExp :: SubExp -> m SubExp,@@ -322,12 +392,12 @@   SOACMapper flore tlore m ->   SOAC flore ->   m (SOAC tlore)-mapSOACM tv (Stream size form lam accs arrs) =+mapSOACM tv (Stream size arrs form accs lam) =   Stream <$> mapOnSOACSubExp tv size+    <*> mapM (mapOnSOACVName tv) arrs     <*> mapOnStreamForm form-    <*> mapOnSOACLambda tv lam     <*> mapM (mapOnSOACSubExp tv) accs-    <*> mapM (mapOnSOACVName tv) arrs+    <*> mapOnSOACLambda tv lam   where     mapOnStreamForm (Parallel o comm lam0) =       Parallel o comm <$> mapOnSOACLambda tv lam0@@ -359,8 +429,9 @@       ops     <*> mapOnSOACLambda tv bucket_fun     <*> mapM (mapOnSOACVName tv) imgs-mapSOACM tv (Screma w (ScremaForm scans reds map_lam) arrs) =+mapSOACM tv (Screma w arrs (ScremaForm scans reds map_lam)) =   Screma <$> mapOnSOACSubExp tv w+    <*> mapM (mapOnSOACVName tv) arrs     <*> ( ScremaForm             <$> forM               scans@@ -376,7 +447,6 @@               )             <*> mapOnSOACLambda tv map_lam         )-    <*> mapM (mapOnSOACVName tv) arrs  instance ASTLore lore => FreeIn (SOAC lore) where   freeIn' = flip execState mempty . mapSOACM free@@ -407,7 +477,7 @@  -- | The type of a SOAC. soacType :: SOAC lore -> [Type]-soacType (Stream outersize _ lam accs _) =+soacType (Stream outersize _ _ accs lam) =   map (substNamesInType substs) rtp   where     nms = map paramName $ take (1 + length accs) params@@ -422,7 +492,7 @@ soacType (Hist _len ops _bucket_fun _imgs) = do   op <- ops   map (`arrayOfRow` histWidth op) (lambdaReturnType $ histOp op)-soacType (Screma w form _arrs) =+soacType (Screma w _arrs form) =   scremaType w form  instance TypedOp (SOAC lore) where@@ -433,12 +503,12 @@    -- Only map functions can consume anything.  The operands to scan   -- and reduce functions are always considered "fresh".-  consumedInOp (Screma _ (ScremaForm _ _ map_lam) arrs) =+  consumedInOp (Screma _ arrs (ScremaForm _ _ map_lam)) =     mapNames consumedArray $ consumedByLambda map_lam     where       consumedArray v = fromMaybe v $ lookup v params_to_arrs       params_to_arrs = zip (map paramName $ lambdaParams map_lam) arrs-  consumedInOp (Stream _ form lam accs arrs) =+  consumedInOp (Stream _ arrs form accs lam) =     namesFromList $       subExpVars $         case form of@@ -472,13 +542,9 @@   where   type OpWithAliases (SOAC lore) = SOAC (Aliases lore) -  addOpAliases aliases (Stream size form lam accs arr) =-    Stream-      size-      (analyseStreamForm form)-      (Alias.analyseLambda aliases lam)-      accs-      arr+  addOpAliases aliases (Stream size arr form accs lam) =+    Stream size arr (analyseStreamForm form) accs $+      Alias.analyseLambda aliases lam     where       analyseStreamForm (Parallel o comm lam0) =         Parallel o comm (Alias.analyseLambda aliases lam0)@@ -491,15 +557,12 @@       (map (mapHistOp (Alias.analyseLambda aliases)) ops)       (Alias.analyseLambda aliases bucket_fun)       imgs-  addOpAliases aliases (Screma w (ScremaForm scans reds map_lam) arrs) =-    Screma-      w-      ( ScremaForm-          (map onScan scans)-          (map onRed reds)-          (Alias.analyseLambda aliases map_lam)-      )-      arrs+  addOpAliases aliases (Screma w arrs (ScremaForm scans reds map_lam)) =+    Screma w arrs $+      ScremaForm+        (map onScan scans)+        (map onRed reds)+        (Alias.analyseLambda aliases map_lam)     where       onRed red = red {redLambda = Alias.analyseLambda aliases $ redLambda red}       onScan scan = scan {scanLambda = Alias.analyseLambda aliases $ scanLambda scan}@@ -540,7 +603,7 @@       Var v -> uncurry (flip ST.Indexed) <$> M.lookup v arr_indexes'       _ -> Nothing     where-      lambdaAndSubExp (Screma _ (ScremaForm scans reds map_lam) arrs) =+      lambdaAndSubExp (Screma _ arrs (ScremaForm scans reds map_lam)) =         nthMapOut (scanResults scans + redResults reds) map_lam arrs       lambdaAndSubExp _ =         Nothing@@ -571,7 +634,7 @@  -- | Type-check a SOAC. typeCheckSOAC :: TC.Checkable lore => SOAC (Aliases lore) -> TC.TypeM lore ()-typeCheckSOAC (Stream size form lam accexps arrexps) = do+typeCheckSOAC (Stream size arrexps form accexps lam) = do   TC.require [Prim int64] size   accargs <- mapM TC.checkArg accexps   arrargs <- mapM lookupType arrexps@@ -696,7 +759,7 @@           ++ prettyTuple (lambdaReturnType bucket_fun)           ++ " but should have type "           ++ prettyTuple bucket_ret_t-typeCheckSOAC (Screma w (ScremaForm scans reds map_lam) arrs) = do+typeCheckSOAC (Screma w arrs (ScremaForm scans reds map_lam)) = do   TC.require [Prim int64] w   arrs' <- TC.checkSOACArrayArgs w arrs   TC.checkLambda map_lam $ map TC.noArgAliases arrs'@@ -741,20 +804,20 @@           ++ " wrong for given scan and reduction functions."  instance OpMetrics (Op lore) => OpMetrics (SOAC lore) where-  opMetrics (Stream _ _ lam _ _) =+  opMetrics (Stream _ _ _ _ lam) =     inside "Stream" $ lambdaMetrics lam   opMetrics (Scatter _len lam _ivs _as) =     inside "Scatter" $ lambdaMetrics lam   opMetrics (Hist _len ops bucket_fun _imgs) =     inside "Hist" $ mapM_ (lambdaMetrics . histOp) ops >> lambdaMetrics bucket_fun-  opMetrics (Screma _ (ScremaForm scans reds map_lam) _) =+  opMetrics (Screma _ _ (ScremaForm scans reds map_lam)) =     inside "Screma" $ do       mapM_ (lambdaMetrics . scanLambda) scans       mapM_ (lambdaMetrics . redLambda) reds       lambdaMetrics map_lam  instance PrettyLore lore => PP.Pretty (SOAC lore) where-  ppr (Stream size form lam acc arrs) =+  ppr (Stream size arrs form acc lam) =     case form of       Parallel o comm lam0 ->         let ord_str = if o == Disorder then "Per" else ""@@ -763,62 +826,67 @@               Noncommutative -> ""          in text ("streamPar" ++ ord_str ++ comm_str)               <> parens-                ( ppr size <> comma </> ppr lam0 <> comma-                    </> ppr lam <> comma-                    </> commasep (PP.braces (commasep $ map ppr acc) : map ppr arrs)+                ( ppr size <> comma+                    </> ppTuple' arrs <> comma+                    </> ppr lam0 <> comma+                    </> ppTuple' acc <> comma+                    </> ppr lam                 )       Sequential ->         text "streamSeq"           <> parens-            ( ppr size <> comma </> ppr lam <> comma-                </> commasep (PP.braces (commasep $ map ppr acc) : map ppr arrs)+            ( ppr size <> comma+                </> ppTuple' arrs <> comma+                </> ppTuple' acc <> comma+                </> ppr lam             )-  ppr (Scatter len lam ivs as) =-    ppSOAC "scatter" len [lam] (Just (map Var ivs)) as+  ppr (Scatter w lam ivs as) =+    "scatter"+      <> parens+        ( ppr w <> comma+            </> ppr lam <> comma+            </> commasep (ppTuple' ivs : map ppr as)+        )   ppr (Hist len ops bucket_fun imgs) =     ppHist len ops bucket_fun imgs-  ppr (Screma w (ScremaForm scans reds map_lam) arrs)+  ppr (Screma w arrs (ScremaForm scans reds map_lam))     | null scans,       null reds =       text "map"         <> parens           ( ppr w <> comma-              </> ppr map_lam <> comma-              </> commasep (map ppr arrs)+              </> ppTuple' arrs <> comma+              </> ppr map_lam           )     | null scans =       text "redomap"         <> parens           ( ppr w <> comma+              </> ppTuple' arrs <> comma               </> PP.braces (mconcat $ intersperse (comma <> PP.line) $ map ppr reds) <> comma-              </> ppr map_lam <> comma-              </> commasep (map ppr arrs)+              </> ppr map_lam           )     | null reds =       text "scanomap"         <> parens           ( ppr w <> comma+              </> ppTuple' arrs <> comma               </> PP.braces (mconcat $ intersperse (comma <> PP.line) $ map ppr scans) <> comma-              </> ppr map_lam <> comma-              </> commasep (map ppr arrs)+              </> ppr map_lam           )-  ppr (Screma w form arrs) = ppScrema w form arrs+  ppr (Screma w arrs form) = ppScrema w arrs form  -- | Prettyprint the given Screma. ppScrema ::-  (PrettyLore lore, Pretty inp) =>-  SubExp ->-  ScremaForm lore ->-  [inp] ->-  Doc-ppScrema w (ScremaForm scans reds map_lam) arrs =+  (PrettyLore lore, Pretty inp) => SubExp -> [inp] -> ScremaForm lore -> Doc+ppScrema w arrs (ScremaForm scans reds map_lam) =   text "screma"     <> parens       ( ppr w <> comma+          </> ppTuple' arrs <> comma           </> PP.braces (mconcat $ intersperse (comma <> PP.line) $ map ppr scans) <> comma           </> PP.braces (mconcat $ intersperse (comma <> PP.line) $ map ppr reds) <> comma-          </> ppr map_lam <> comma-          </> commasep (map ppr arrs)+          </> ppr map_lam       )  instance PrettyLore lore => Pretty (Scan lore) where@@ -855,26 +923,3 @@       ppr w <> comma <+> ppr rf <> comma <+> PP.braces (commasep $ map ppr dests) <> comma         </> PP.braces (commasep $ map ppr nes) <> comma         </> ppr op--ppSOAC ::-  (Pretty fn, Pretty v) =>-  String ->-  SubExp ->-  [fn] ->-  Maybe [SubExp] ->-  [v] ->-  Doc-ppSOAC name size funs es as =-  text name-    <> parens-      ( ppr size <> comma-          </> ppList funs-          </> commasep (es' ++ map ppr as)-      )-  where-    es' = maybe [] ((: []) . ppTuple') es--ppList :: Pretty a => [a] -> Doc-ppList as = case map ppr as of-  [] -> mempty-  a' : as' -> foldl (</>) (a' <> comma) $ map (<> comma) as'

@@ -95,13 +95,16 @@ simplifySOAC ::   Simplify.SimplifiableLore lore =>   Simplify.SimplifyOp lore (SOAC lore)-simplifySOAC (Stream outerdim form lam nes arr) = do+simplifySOAC (Stream outerdim arr form nes lam) = do   outerdim' <- Engine.simplify outerdim   (form', form_hoisted) <- simplifyStreamForm form   nes' <- mapM Engine.simplify nes   arr' <- mapM Engine.simplify arr   (lam', lam_hoisted) <- Engine.simplifyLambda lam-  return (Stream outerdim' form' lam' nes' arr', form_hoisted <> lam_hoisted)+  return+    ( Stream outerdim' arr' form' nes' lam',+      form_hoisted <> lam_hoisted+    )   where     simplifyStreamForm (Parallel o comm lam0) = do       (lam0', hoisted) <- Engine.simplifyLambda lam0@@ -127,7 +130,7 @@   imgs' <- mapM Engine.simplify imgs   (bfun', bfun_hoisted) <- Engine.simplifyLambda bfun   return (Hist w' ops' bfun' imgs', mconcat hoisted <> bfun_hoisted)-simplifySOAC (Screma w (ScremaForm scans reds map_lam) arrs) = do+simplifySOAC (Screma w arrs (ScremaForm scans reds map_lam)) = do   (scans', scans_hoisted) <- fmap unzip $     forM scans $ \(Scan lam nes) -> do       (lam', hoisted) <- Engine.simplifyLambda lam@@ -144,8 +147,8 @@    (,)     <$> ( Screma <$> Engine.simplify w-            <*> pure (ScremaForm scans' reds' map_lam')             <*> Engine.simplify arrs+            <*> pure (ScremaForm scans' reds' map_lam')         )     <*> pure (mconcat scans_hoisted <> mconcat reds_hoisted <> map_lam_hoisted) @@ -257,7 +260,7 @@   (Bindable lore, Simplify.SimplifiableLore lore, HasSOAC (Wise lore)) =>   TopDownRuleOp (Wise lore) liftIdentityMapping _ pat aux op-  | Just (Screma w form arrs :: SOAC (Wise lore)) <- asSOAC op,+  | Just (Screma w arrs form :: SOAC (Wise lore)) <- asSOAC op,     Just fun <- isMapSOAC form = do     let inputMap = M.fromList $ zip (map paramName $ lambdaParams fun) arrs         free = freeIn $ lambdaBody fun@@ -297,11 +300,11 @@                 }         mapM_ (uncurry letBind) invariant         auxing aux $-          letBindNames (map patElemName pat') $ Op $ soacOp $ Screma w (mapSOAC fun') arrs+          letBindNames (map patElemName pat') $ Op $ soacOp $ Screma w arrs (mapSOAC fun') liftIdentityMapping _ _ _ _ = Skip  liftIdentityStreaming :: BottomUpRuleOp (Wise SOACS)-liftIdentityStreaming _ (Pattern [] pes) aux (Stream w form lam nes arrs)+liftIdentityStreaming _ (Pattern [] pes) aux (Stream w arrs form nes lam)   | (variant_map, invariant_map) <-       partitionEithers $ map isInvariantRes $ zip3 map_ts map_pes map_res,     not $ null invariant_map = Simplify $ do@@ -317,7 +320,7 @@      auxing aux $       letBind (Pattern [] $ fold_pes ++ variant_map_pes) $-        Op $ Stream w form lam' nes arrs+        Op $ Stream w arrs form nes lam'   where     num_folds = length nes     (fold_pes, map_pes) = splitAt num_folds pes@@ -339,11 +342,11 @@   (Bindable lore, Simplify.SimplifiableLore lore, HasSOAC (Wise lore)) =>   TopDownRuleOp (Wise lore) removeReplicateMapping vtable pat aux op-  | Just (Screma w form arrs) <- asSOAC op,+  | Just (Screma w arrs form) <- asSOAC op,     Just fun <- isMapSOAC form,     Just (bnds, fun', arrs') <- removeReplicateInput vtable fun arrs = Simplify $ do     forM_ bnds $ \(vs, cs, e) -> certifying cs $ letBindNames vs e-    auxing aux $ letBind pat $ Op $ soacOp $ Screma w (mapSOAC fun') arrs'+    auxing aux $ letBind pat $ Op $ soacOp $ Screma w arrs' $ mapSOAC fun' removeReplicateMapping _ _ _ _ = Skip  -- | Like 'removeReplicateMapping', but for 'Scatter'.@@ -393,12 +396,12 @@  -- | Remove inputs that are not used inside the SOAC. removeUnusedSOACInput :: TopDownRuleOp (Wise SOACS)-removeUnusedSOACInput _ pat aux (Screma w (ScremaForm scan reduce map_lam) arrs)+removeUnusedSOACInput _ pat aux (Screma w arrs (ScremaForm scan reduce map_lam))   | (used, unused) <- partition usedInput params_and_arrs,     not (null unused) = Simplify $ do     let (used_params, used_arrs) = unzip used         map_lam' = map_lam {lambdaParams = used_params}-    auxing aux $ letBind pat $ Op $ Screma w (ScremaForm scan reduce map_lam') used_arrs+    auxing aux $ letBind pat $ Op $ Screma w used_arrs (ScremaForm scan reduce map_lam')   where     params_and_arrs = zip (lambdaParams map_lam) arrs     used_in_body = freeIn $ lambdaBody map_lam@@ -406,7 +409,7 @@ removeUnusedSOACInput _ _ _ _ = Skip  removeDeadMapping :: BottomUpRuleOp (Wise SOACS)-removeDeadMapping (_, used) pat aux (Screma w form arrs)+removeDeadMapping (_, used) pat aux (Screma w arrs form)   | Just fun <- isMapSOAC form =     let ses = bodyResult $ lambdaBody fun         isUsed (bindee, _, _) = (`UT.used` used) $ patElemName bindee@@ -423,12 +426,12 @@           then             Simplify $               auxing aux $-                letBind (Pattern [] pat') $ Op $ Screma w (mapSOAC fun') arrs+                letBind (Pattern [] pat') $ Op $ Screma w arrs $ mapSOAC fun'           else Skip removeDeadMapping _ _ _ _ = Skip  removeDuplicateMapOutput :: TopDownRuleOp (Wise SOACS)-removeDuplicateMapOutput _ pat aux (Screma w form arrs)+removeDuplicateMapOutput _ pat aux (Screma w arrs form)   | Just fun <- isMapSOAC form =     let ses = bodyResult $ lambdaBody fun         ts = lambdaReturnType fun@@ -446,7 +449,7 @@                     { lambdaBody = (lambdaBody fun) {bodyResult = ses'},                       lambdaReturnType = ts'                     }-            auxing aux $ letBind pat' $ Op $ Screma w (mapSOAC fun') arrs+            auxing aux $ letBind pat' $ Op $ Screma w arrs $ mapSOAC fun'             forM_ copies $ \(from, to) ->               letBind (Pattern [] [to]) $ BasicOp $ Copy $ patElemName from   where@@ -523,7 +526,7 @@     ) isMapWithOp pat e   | Pattern [] [map_pe] <- pat,-    Screma w form arrs <- e,+    Screma w arrs form <- e,     Just map_lam <- isMapSOAC form,     [Let (Pattern [] [pe]) aux2 e'] <-       stmsToList $ bodyStms $ lambdaBody map_lam,@@ -537,7 +540,7 @@ -- the data dependencies to see that the "dead" result is not -- actually used for computing one of the live ones. removeDeadReduction :: BottomUpRuleOp (Wise SOACS)-removeDeadReduction (_, used) pat aux (Screma w form arrs)+removeDeadReduction (_, used) pat aux (Screma w arrs form)   | Just ([Reduce comm redlam nes], maplam) <- isRedomapSOAC form,     not $ all (`UT.used` used) $ patternNames pat, -- Quick/cheap check     let (red_pes, map_pes) = splitAt (length nes) $ patternElements pat,@@ -567,14 +570,14 @@      auxing aux $       letBind (Pattern [] $ used_red_pes ++ map_pes) $-        Op $ Screma w (redomapSOAC [Reduce comm redlam' used_nes] maplam') arrs+        Op $ Screma w arrs $ redomapSOAC [Reduce comm redlam' used_nes] maplam' removeDeadReduction _ _ _ _ = Skip  -- | If we are writing to an array that is never used, get rid of it. removeDeadWrite :: BottomUpRuleOp (Wise SOACS) removeDeadWrite (_, used) pat aux (Scatter w fun arrs dests) =-  let (i_ses, v_ses) = splitAt (length dests) $ bodyResult $ lambdaBody fun-      (i_ts, v_ts) = splitAt (length dests) $ lambdaReturnType fun+  let (i_ses, v_ses) = unzip $ groupScatterResults' dests $ bodyResult $ lambdaBody fun+      (i_ts, v_ts) = unzip $ groupScatterResults' dests $ lambdaReturnType fun       isUsed (bindee, _, _, _, _, _) = (`UT.used` used) $ patElemName bindee       (pat', i_ses', v_ses', i_ts', v_ts', dests') =         unzip6 $@@ -582,8 +585,8 @@             zip6 (patternElements pat) i_ses v_ses i_ts v_ts dests       fun' =         fun-          { lambdaBody = (lambdaBody fun) {bodyResult = i_ses' ++ v_ses'},-            lambdaReturnType = i_ts' ++ v_ts'+          { lambdaBody = (lambdaBody fun) {bodyResult = concat i_ses' ++ v_ses'},+            lambdaReturnType = concat i_ts' ++ v_ts'           }    in if pat /= Pattern [] pat'         then@@ -601,11 +604,10 @@     all (w' ==) ws = Simplify $ do     let r = length xivs     fun2s <- mapM (\_ -> renameLambda fun) [1 .. r -1]-    let fun_n = length $ lambdaReturnType fun-        (fun_is, fun_vs) =+    let (fun_is, fun_vs) =           unzip $             map-              ( splitAt (fun_n `div` 2)+              ( splitScatterResults dests                   . bodyResult                   . lambdaBody               )@@ -613,7 +615,7 @@         (its, vts) =           unzip $             replicate r $-              splitAt (fun_n `div` 2) $ lambdaReturnType fun+              splitScatterResults dests $ lambdaReturnType fun         new_stmts = mconcat $ map (bodyStms . lambdaBody) (fun : fun2s)     let fun' =           Lambda@@ -644,13 +646,13 @@ fuseConcatScatter _ _ _ _ = Skip  simplifyClosedFormReduce :: TopDownRuleOp (Wise SOACS)-simplifyClosedFormReduce _ pat _ (Screma (Constant w) form _)+simplifyClosedFormReduce _ pat _ (Screma (Constant w) _ form)   | Just nes <- concatMap redNeutral . fst <$> isRedomapSOAC form,     zeroIsh w =     Simplify $       forM_ (zip (patternNames pat) nes) $ \(v, ne) ->         letBindNames [v] $ BasicOp $ SubExp ne-simplifyClosedFormReduce vtable pat _ (Screma _ form arrs)+simplifyClosedFormReduce vtable pat _ (Screma _ arrs form)   | Just [Reduce _ red_fun nes] <- isReduceSOAC form =     Simplify $ foldClosedForm (`ST.lookupExp` vtable) pat red_fun nes arrs simplifyClosedFormReduce _ _ _ _ = Skip@@ -660,7 +662,7 @@   (Bindable lore, Simplify.SimplifiableLore lore, HasSOAC (Wise lore)) =>   TopDownRuleOp (Wise lore) simplifyKnownIterationSOAC _ pat _ op-  | Just (Screma (Constant k) (ScremaForm scans reds map_lam) arrs) <- asSOAC op,+  | Just (Screma (Constant k) arrs (ScremaForm scans reds map_lam)) <- asSOAC op,     oneIsh k = Simplify $ do     let (Reduce _ red_lam red_nes) = singleReduce reds         (Scan scan_lam scan_nes) = singleScan scans@@ -688,7 +690,7 @@     zipWithM_ bindResult red_pes red_res     zipWithM_ bindArrayResult map_pes map_res simplifyKnownIterationSOAC _ pat _ op-  | Just (Stream (Constant k) _ fold_lam nes arrs) <- asSOAC op,+  | Just (Stream (Constant k) arrs _ nes fold_lam) <- asSOAC op,     oneIsh k = Simplify $ do     let (chunk_param, acc_params, slice_params) =           partitionChunkedFoldParameters (length nes) (lambdaParams fold_lam)@@ -801,7 +803,7 @@ -- complex situations (rotate or whatnot), consider turning it into a -- separate compiler pass instead. simplifyMapIota :: TopDownRuleOp (Wise SOACS)-simplifyMapIota vtable pat aux (Screma w (ScremaForm scan reduce map_lam) arrs)+simplifyMapIota vtable pat aux (Screma w arrs (ScremaForm scan reduce map_lam))   | Just (p, _) <- find isIota (zip (lambdaParams map_lam) arrs),     indexings <-       filter (indexesWith (paramName p)) $@@ -823,7 +825,7 @@             }      auxing aux $-      letBind pat $ Op $ Screma w (ScremaForm scan reduce map_lam') (arrs <> more_arrs)+      letBind pat $ Op $ Screma w (arrs <> more_arrs) (ScremaForm scan reduce map_lam')   where     isIota (_, arr) = case ST.lookupBasicOp arr vtable of       Just (Iota _ (Constant o) (Constant s) _, _) ->@@ -862,7 +864,7 @@ -- corresponding to that transformation performed on the rows of the -- full array. moveTransformToInput :: TopDownRuleOp (Wise SOACS)-moveTransformToInput vtable pat aux (Screma w (ScremaForm scan reduce map_lam) arrs)+moveTransformToInput vtable pat aux (Screma w arrs (ScremaForm scan reduce map_lam))   | ops <- map snd $ filter arrayIsMapParam $ S.toList $ arrayOps $ lambdaBody map_lam,     not $ null ops = Simplify $ do     (more_arrs, more_params, replacements) <-@@ -880,7 +882,7 @@             }      auxing aux $-      letBind pat $ Op $ Screma w (ScremaForm scan reduce map_lam') (arrs <> more_arrs)+      letBind pat $ Op $ Screma w (arrs <> more_arrs) (ScremaForm scan reduce map_lam')   where     map_param_names = map paramName (lambdaParams map_lam)     topLevelPattern = (`elem` fmap stmPattern (bodyStms (lambdaBody map_lam)))

@@ -1174,7 +1174,7 @@   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 form lam' [] arrs+  letTupExp' desc $ I.Op $ I.Stream w arrs form [] lam'  internaliseStreamRed ::   String ->@@ -1245,7 +1245,7 @@             lambdaReturnType = nes_ts           }   w <- arraysSize 0 <$> mapM lookupType arrs-  letTupExp' desc $ I.Op $ I.Stream w form lam' nes arrs+  letTupExp' desc $ I.Op $ I.Stream w arrs form nes lam'  internaliseExp1 :: String -> E.Exp -> InternaliseM I.SubExp internaliseExp1 desc e = do@@ -1576,12 +1576,12 @@                 cmps <-                   letExp "cmps" $                     I.Op $-                      I.Screma x_num_elems (I.mapSOAC cmp_lam) [x_flat, y_flat]+                      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 reduce [cmps]+                all_equal <- letSubExp "all_equal" $ I.Op $ I.Screma x_num_elems [cmps] reduce                 return $ resultBody [all_equal]                letSubExp "arrays_equal" $@@ -1604,7 +1604,7 @@       w <- arraysSize 0 <$> mapM lookupType arr'       letTupExp' desc $         I.Op $-          I.Screma w (I.mapSOAC lam') arr'+          I.Screma w arr' (I.mapSOAC lam')     handleSOACs [TupLit [k, lam, arr] _] "partition" = do       k' <- fromIntegral <$> fromInt32 k       Just $ \_desc -> do@@ -1619,19 +1619,19 @@       internaliseScanOrReduce desc "reduce" reduce (lam, ne, arr, loc)       where         reduce w red_lam nes arrs =-          I.Screma w-            <$> I.reduceSOAC [Reduce Noncommutative red_lam nes] <*> pure 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-            <$> I.reduceSOAC [Reduce Commutative red_lam nes] <*> pure 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 <$> I.scanSOAC [Scan scan_lam nes] <*> pure 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 ->@@ -1712,8 +1712,11 @@         r <- I.arrayRank <$> lookupType v         return $ I.Rearrange ([1, 0] ++ [2 .. r -1]) v     handleRest [TupLit [x, y] _] "zip" = Just $ \desc ->-      (++) <$> internaliseExp (desc ++ "_zip_x") x-        <*> internaliseExp (desc ++ "_zip_y") y+      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@@ -1906,7 +1909,7 @@ 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 (mapSOAC lam) arrs+  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"@@ -1934,7 +1937,7 @@       nes = replicate (length increments) $ intConst Int64 0    scan <- I.scanSOAC [I.Scan add_lam nes]-  all_offsets <- letTupExp "offsets" $ I.Op $ I.Screma w scan increments+  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

@@ -727,7 +727,7 @@                 lambdaBody = lam_body,                 lambdaReturnType = map paramType $ acc_params ++ [offset_param]               }-          stream = Futhark.Stream w Sequential lam (merge_init ++ [intConst it 0]) loop_arrs+          stream = Futhark.Stream w loop_arrs Sequential (merge_init ++ [intConst it 0]) lam        -- It is important that the (discarded) final-offset is not the       -- first element in the pattern, as we use the first element to@@ -997,7 +997,7 @@   Binder SOACS (Futhark.SOAC SOACS) copyNewlyConsumed was_consumed soac =   case soac of-    Futhark.Screma w (Futhark.ScremaForm scans reds map_lam) arrs -> do+    Futhark.Screma w arrs (Futhark.ScremaForm scans reds map_lam) -> do       -- Copy any arrays that are consumed now, but were not in the       -- constituents.       arrs' <- mapM copyConsumedArr arrs@@ -1028,7 +1028,7 @@               )               reds -      return $ Futhark.Screma w (Futhark.ScremaForm scans' reds' map_lam') arrs'+      return $ Futhark.Screma w arrs' $ Futhark.ScremaForm scans' reds' map_lam'     _ -> return $ removeOpAliases soac   where     consumed = consumedInOp soac

@@ -450,33 +450,29 @@             SOAC.Hist w (ops_c <> ops_p) lam' (inp_c_arr <> inp_p_arr)      -- Scatter-write fusion.-    ( SOAC.Scatter _len2 _lam_c ivs2 as2,+    ( SOAC.Scatter _len_c _lam_c ivs_c as_c,       SOAC.Scatter _len_p _lam_p ivs_p as_p       )         | horizFuse -> do-          let zipW xs ys = ys_p ++ xs_p ++ ys2 ++ xs2+          let zipW as_xs xs as_ys ys = xs_indices ++ ys_indices ++ xs_vals ++ ys_vals                 where-                  lenx = length xs `div` 2-                  xs_p = take lenx xs-                  xs2 = drop lenx xs-                  leny = length ys `div` 2-                  ys_p = take leny ys-                  ys2 = drop leny ys-          let (body_p, body2) = (lambdaBody lam_p, lambdaBody lam_c)+                  (xs_indices, xs_vals) = splitScatterResults as_xs xs+                  (ys_indices, ys_vals) = splitScatterResults as_ys ys+          let (body_p, body_c) = (lambdaBody lam_p, lambdaBody lam_c)           let body' =                 Body-                  { bodyDec = bodyDec body_p, -- body_p and body2 have the same lores-                    bodyStms = bodyStms body_p <> bodyStms body2,-                    bodyResult = zipW (bodyResult body_p) (bodyResult body2)+                  { bodyDec = bodyDec body_p, -- body_p and body_c have the same lores+                    bodyStms = bodyStms body_p <> bodyStms body_c,+                    bodyResult = zipW as_c (bodyResult body_c) as_p (bodyResult body_p)                   }           let lam' =                 Lambda-                  { lambdaParams = lambdaParams lam_p ++ lambdaParams lam_c,+                  { lambdaParams = lambdaParams lam_c ++ lambdaParams lam_p,                     lambdaBody = body',-                    lambdaReturnType = zipW (lambdaReturnType lam_p) (lambdaReturnType lam_c)+                    lambdaReturnType = zipW as_c (lambdaReturnType lam_c) as_p (lambdaReturnType lam_p)                   }           success (outNames ker ++ returned_outvars) $-            SOAC.Scatter w lam' (ivs_p ++ ivs2) (as2 ++ as_p)+            SOAC.Scatter w lam' (ivs_c ++ ivs_p) (as_c ++ as_p)     (SOAC.Scatter {}, _) ->       fail "Cannot fuse a write with anything else than a write or a map"     (_, SOAC.Scatter {}) ->@@ -689,7 +685,7 @@           mkBody             ( oneStm $                 Let (setPatternOuterDimTo w map_pat) (defAux ()) $-                  Op $ Futhark.Screma w scan_form arrs'+                  Op $ Futhark.Screma w arrs' scan_form             )             $ map Var $ patternNames map_pat         map_fun' = Lambda map_params map_body map_rettype

@@ -288,6 +288,36 @@     Just (Iota n offset stride it, v_cs) simplifyReshapeIota _ _ _ = Nothing +reshapeSlice :: [DimIndex d] -> [d] -> [DimIndex d]+reshapeSlice (DimFix i : slice') scs =+  DimFix i : reshapeSlice slice' scs+reshapeSlice (DimSlice x _ s : slice') (d : ds') =+  DimSlice x d s : reshapeSlice slice' ds'+reshapeSlice _ _ = []++-- If we are size-coercing a slice, then we might as well just use a+-- different slice instead.+simplifyReshapeIndex :: SimpleRule lore+simplifyReshapeIndex defOf _ (Reshape newshape v)+  | Just ds <- shapeCoercion newshape,+    Just (BasicOp (Index v' slice), v_cs) <- defOf v,+    slice' <- reshapeSlice slice ds,+    slice' /= slice =+    Just (Index v' slice', v_cs)+simplifyReshapeIndex _ _ _ = Nothing++-- If we are updating a slice with the result of a size coercion, we+-- instead use the original array and update the slice dimensions.+simplifyUpdateReshape :: SimpleRule lore+simplifyUpdateReshape defOf seType (Update dest slice (Var v))+  | Just (BasicOp (Reshape newshape v'), v_cs) <- defOf v,+    Just _ <- shapeCoercion newshape,+    Just ds <- arrayDims <$> seType (Var v'),+    slice' <- reshapeSlice slice ds,+    slice' /= slice =+    Just (Update dest slice' $ Var v', v_cs)+simplifyUpdateReshape _ _ _ = Nothing+ improveReshape :: SimpleRule lore improveReshape _ seType (Reshape newshape v)   | Just t <- seType $ Var v,@@ -327,6 +357,8 @@     simplifyReshapeScratch,     simplifyReshapeReplicate,     simplifyReshapeIota,+    simplifyReshapeIndex,+    simplifyUpdateReshape,     improveReshape   ] 

@@ -448,7 +448,7 @@       (Commutativity, Lambda Kernels, [SubExp], Lambda Kernels)     ) tileable stm-  | Op (OtherOp (Screma w form arrs)) <- stmExp stm,+  | Op (OtherOp (Screma w arrs form)) <- stmExp stm,     Just (reds, map_lam) <- isRedomapSOAC form,     Reduce red_comm red_lam red_nes <- singleReduce reds,     lambdaReturnType map_lam == lambdaReturnType red_lam, -- No mapout arrays.@@ -843,7 +843,7 @@       letTupExp "acc"         =<< eIf           (toExp $ le64 gtid .<. pe64 kdim)-          (eBody [pure $ Op $ OtherOp $ Screma tile_size form' tiles'])+          (eBody [pure $ Op $ OtherOp $ Screma tile_size tiles' form'])           (resultBodyM thread_accs)   where     lvl = SegThread num_groups group_size SegNoVirt@@ -1123,7 +1123,7 @@           =<< eIf             ( toExp $ le64 gtid_x .<. pe64 kdim_x .&&. le64 gtid_y .<. pe64 kdim_y             )-            (eBody [pure $ Op $ OtherOp $ Screma actual_tile_size form' tiles'])+            (eBody [pure $ Op $ OtherOp $ Screma actual_tile_size tiles' form'])             (resultBodyM thread_accs)  processResidualTile2D ::

@@ -110,7 +110,7 @@       (Commutativity, Lambda Kernels, [SubExp], Lambda Kernels)     ) isTileableRedomap stm-  | Op (OtherOp (Screma w form arrs)) <- stmExp stm,+  | Op (OtherOp (Screma w arrs form)) <- stmExp stm,     Just (reds, map_lam) <- isRedomapSOAC form,     Reduce red_comm red_lam red_nes <- singleReduce reds,     all (primType . rowType . paramType) $ lambdaParams red_lam,

@@ -163,7 +163,6 @@ import Control.Monad.Identity import Control.Monad.RWS.Strict import Control.Monad.Reader-import Data.Function ((&)) import Data.Maybe import qualified Futhark.IR.Kernels as Out import Futhark.IR.Kernels.Kernel@@ -181,7 +180,6 @@ import Futhark.Tools import qualified Futhark.Transform.FirstOrderTransform as FOT import Futhark.Transform.Rename-import Futhark.Util import Futhark.Util.Log import Prelude hiding (log) @@ -295,7 +293,7 @@       not $ isBuiltInFunction fname  sequentialisedUnbalancedStm :: Stm -> DistribM (Maybe (Stms SOACS))-sequentialisedUnbalancedStm (Let pat _ (Op soac@(Screma _ form _)))+sequentialisedUnbalancedStm (Let pat _ (Op soac@(Screma _ _ form)))   | Just (_, lam2) <- isRedomapSOAC form,     unbalancedLambda lam2,     lambdaContainsParallelism lam2 = do@@ -368,10 +366,10 @@         WhileLoop cond       ForLoop i it bound ps ->         ForLoop i it bound ps-transformStm path (Let pat aux (Op (Screma w form arrs)))+transformStm path (Let pat aux (Op (Screma w arrs form)))   | Just lam <- isMapSOAC form =     onMap path $ MapLoop pat aux w lam arrs-transformStm path (Let res_pat (StmAux cs _ _) (Op (Screma w form arrs)))+transformStm path (Let res_pat (StmAux cs _ _) (Op (Screma w arrs form)))   | Just scans <- isScanSOAC form,     Scan scan_lam nes <- singleScan scans,     Just do_iswim <- iswim res_pat w scan_lam $ zip nes arrs = do@@ -406,7 +404,7 @@     let map_lam' = soacsLambdaToKernels map_lam     lvl <- segThreadCapped [w] "segscan" $ NoRecommendation SegNoVirt     addStms =<< segScan lvl res_pat w scan_ops map_lam' arrs [] []-transformStm path (Let res_pat aux (Op (Screma w form arrs)))+transformStm path (Let res_pat aux (Op (Screma w arrs form)))   | Just [Reduce comm red_fun nes] <- isReduceSOAC form,     let comm'           | commutativeLambda red_fun = Commutative@@ -415,7 +413,7 @@     types <- asksScope scopeForSOACs     (_, bnds) <- fst <$> runBinderT (simplifyStms =<< collectStms_ (auxing aux do_irwim)) types     transformStms path $ stmsToList bnds-transformStm path (Let pat aux@(StmAux cs _ _) (Op (Screma w form arrs)))+transformStm path (Let pat aux@(StmAux cs _ _) (Op (Screma w arrs form)))   | Just (reds, map_lam) <- isRedomapSOAC form = do     let paralleliseOuter = runBinder_ $ do           red_ops <- forM reds $ \(Reduce comm red_lam nes) -> do@@ -466,14 +464,14 @@  -- Streams can be handled in two different ways - either we -- sequentialise the body or we keep it parallel and distribute.-transformStm path (Let pat aux@(StmAux cs _ _) (Op (Stream w Parallel {} map_fun [] arrs)))+transformStm path (Let pat aux@(StmAux cs _ _) (Op (Stream w arrs Parallel {} [] map_fun)))   | not ("sequential_inner" `inAttrs` stmAuxAttrs aux) = do     -- No reduction part.  Remove the stream and leave the body     -- parallel.  It will be distributed.     types <- asksScope scopeForSOACs     transformStms path . stmsToList . snd       =<< runBinderT (certifying cs $ sequentialStreamWholeArray pat w [] map_fun arrs) types-transformStm path (Let pat aux@(StmAux cs _ _) (Op (Stream w (Parallel o comm red_fun) fold_fun nes arrs)))+transformStm path (Let pat aux@(StmAux cs _ _) (Op (Stream w arrs (Parallel o comm red_fun) nes fold_fun)))   | "sequential_inner" `inAttrs` stmAuxAttrs aux =     paralleliseOuter path   | otherwise = do@@ -514,7 +512,7 @@             stms             ( transformStm path' $                 Let red_pat aux {stmAuxAttrs = mempty} $-                  Op (Screma num_threads reduce_soac red_results)+                  Op (Screma num_threads red_results reduce_soac)             )       | otherwise = do         let red_fun_sequential = soacsLambdaToKernels red_fun@@ -546,13 +544,13 @@     comm'       | commutativeLambda red_fun, o /= InOrder = Commutative       | otherwise = comm-transformStm path (Let pat (StmAux cs _ _) (Op (Screma w form arrs))) = do+transformStm path (Let pat (StmAux cs _ _) (Op (Screma w arrs form))) = do   -- This screma is too complicated for us to immediately do   -- anything, so split it up and try again.   scope <- asksScope scopeForSOACs   transformStms path . map (certify cs) . stmsToList . snd     =<< runBinderT (dissectScrema pat w form arrs) scope-transformStm path (Let pat _ (Op (Stream w Sequential fold_fun nes arrs))) = do+transformStm path (Let pat _ (Op (Stream w arrs Sequential nes fold_fun))) = do   -- Remove the stream and leave the body parallel.  It will be   -- distributed.   types <- asksScope scopeForSOACs@@ -561,15 +559,11 @@ transformStm _ (Let pat (StmAux cs _ _) (Op (Scatter w lam ivs as))) = runBinder_ $ do   let lam' = soacsLambdaToKernels lam   write_i <- newVName "write_i"-  let (as_ws, as_ns, as_vs) = unzip3 as-      indexes = zipWith (*) as_ns $ map length as_ws-      (i_res, v_res) = splitAt (sum indexes) $ bodyResult $ lambdaBody lam'+  let (as_ws, _, _) = unzip3 as       kstms = bodyStms $ lambdaBody lam'       krets = do         (a_w, a, is_vs) <--          zip (chunks (concat $ zipWith (\ws n -> replicate n $ length ws) as_ws as_ns) i_res) v_res-            & chunks as_ns-            & zip3 as_ws as_vs+          groupScatterResults as $ bodyResult $ lambdaBody lam'         return $ WriteReturns a_w a [(map DimFix is, v) | (is, v) <- is_vs]       body = KernelBody () kstms krets       inputs = do@@ -619,7 +613,7 @@     interest stm       | "sequential" `inAttrs` attrs =         0 :: Int-      | Op (Screma w form _) <- stmExp stm,+      | Op (Screma w _ form) <- stmExp stm,         Just lam' <- isMapSOAC form =         mapLike w lam'       | Op (Scatter w lam' _ _) <- stmExp stm =@@ -628,9 +622,9 @@         bodyInterest body * 10       | If _ tbody fbody _ <- stmExp stm =         max (bodyInterest tbody) (bodyInterest fbody)-      | Op (Screma w (ScremaForm _ _ lam') _) <- stmExp stm =+      | Op (Screma w _ (ScremaForm _ _ lam')) <- stmExp stm =         zeroIfTooSmall w + bodyInterest (lambdaBody lam')-      | Op (Stream _ Sequential lam' _ _) <- stmExp stm =+      | Op (Stream _ _ Sequential _ lam') <- stmExp stm =         bodyInterest $ lambdaBody lam'       | otherwise =         0@@ -657,7 +651,7 @@     interest stm       | "sequential" `inAttrs` attrs =         0 :: Int-      | Op (Screma _ form@(ScremaForm _ _ lam') _) <- stmExp stm,+      | Op (Screma _ _ form@(ScremaForm _ _ lam')) <- stmExp stm,         isJust $ isMapSOAC form =         if sequential_inner           then 0@@ -666,7 +660,7 @@         0 -- Basically a map.       | DoLoop _ _ ForLoop {} body <- stmExp stm =         bodyInterest body * 10-      | Op (Screma _ form@(ScremaForm _ _ lam') _) <- stmExp stm =+      | Op (Screma _ _ form@(ScremaForm _ _ lam')) <- stmExp stm =         1 + bodyInterest (lambdaBody lam')           +           -- Give this a bigger score if it's a redomap, as these

@@ -69,7 +69,7 @@  mapLoopStm :: MapLoop -> Stm SOACS mapLoopStm (MapLoop pat aux w lam arrs) =-  Let pat aux $ Op $ Screma w (mapSOAC lam) arrs+  Let pat aux $ Op $ Screma w arrs $ mapSOAC lam  data DistEnv lore m = DistEnv   { distNest :: Nestings,@@ -251,10 +251,8 @@                   lambdaReturnType = map rowType $ patternTypes pat                 }         stms <--          runBinder_ $-            auxing aux $-              FOT.transformSOAC pat $-                Screma w (mapSOAC lam') used_arrs+          runBinder_ . auxing aux . FOT.transformSOAC pat $+            Screma w used_arrs $ mapSOAC lam'          return $ acc {distTargets = newtargets, distStms = stms}       | otherwise -> do@@ -339,7 +337,7 @@ distributeMapBodyStms orig_acc = distribute <=< onStms orig_acc . stmsToList   where     onStms acc [] = return acc-    onStms acc (Let pat (StmAux cs _ _) (Op (Stream w Sequential lam accs arrs)) : stms) = do+    onStms acc (Let pat (StmAux cs _ _) (Op (Stream w arrs Sequential accs lam)) : stms) = do       types <- asksScope scopeForSOACs       stream_stms <-         snd <$> runBinderT (sequentialStreamWholeArray pat w accs lam arrs) types@@ -374,7 +372,7 @@   | "sequential_outer" `inAttrs` stmAuxAttrs aux =     distributeMapBodyStms acc . fmap (certify (stmAuxCerts aux))       =<< runBinder_ (FOT.transformSOAC pat soac)-maybeDistributeStm stm@(Let pat _ (Op (Screma w form arrs))) acc+maybeDistributeStm stm@(Let pat _ (Op (Screma w arrs form))) acc   | Just lam <- isMapSOAC form =     -- Only distribute inside the map if we can distribute everything     -- following the map.@@ -438,7 +436,7 @@             return acc'       _ ->         addStmToAcc stm acc-maybeDistributeStm (Let pat aux (Op (Screma w form arrs))) acc+maybeDistributeStm (Let pat aux (Op (Screma w arrs form))) acc   | Just [Reduce comm lam nes] <- isReduceSOAC form,     Just m <- irwim pat w comm lam $ zip nes arrs = do     types <- asksScope scopeForSOACs@@ -496,7 +494,7 @@ -- -- If the scan cannot be distributed by itself, it will be -- sequentialised in the default case for this function.-maybeDistributeStm bnd@(Let pat (StmAux cs _ _) (Op (Screma w form arrs))) acc+maybeDistributeStm bnd@(Let pat (StmAux cs _ _) (Op (Screma w arrs form))) acc   | Just (scans, map_lam) <- isScanomapSOAC form,     Scan lam nes <- singleScan scans =     distributeSingleStm acc bnd >>= \case@@ -518,7 +516,7 @@ -- -- If the reduction cannot be distributed by itself, it will be -- sequentialised in the default case for this function.-maybeDistributeStm bnd@(Let pat (StmAux cs _ _) (Op (Screma w form arrs))) acc+maybeDistributeStm bnd@(Let pat (StmAux cs _ _) (Op (Screma w arrs form))) acc   | Just (reds, map_lam) <- isRedomapSOAC form,     Reduce comm lam nes <- singleReduce reds =     distributeSingleStm acc bnd >>= \case@@ -540,7 +538,7 @@               >>= kernelOrNot cs bnd acc kernels acc'       _ ->         addStmToAcc bnd acc-maybeDistributeStm (Let pat (StmAux cs _ _) (Op (Screma w form arrs))) acc = do+maybeDistributeStm (Let pat (StmAux cs _ _) (Op (Screma w arrs form))) acc = do   -- This Screma is too complicated for us to immediately do   -- anything, so split it up and try again.   scope <- asksScope scopeForSOACs@@ -550,7 +548,7 @@   | [t] <- patternTypes pat = do     tmp <- newVName "tmp"     let rowt = rowType t-        newbnd = Let pat aux $ Op $ Screma d (mapSOAC lam) []+        newbnd = Let pat aux $ Op $ Screma d [] $ mapSOAC lam         tmpbnd =           Let (Pattern [] [PatElem tmp rowt]) aux $             BasicOp $ Replicate (Shape ds) v@@ -801,9 +799,7 @@         else certifying cs $ letSubExp "scatter_i" $ BasicOp $ SubExp i    let k_body =-        zip (chunks (concat $ zipWith (\ws n -> replicate n $ length ws) as_ws as_ns) is') vs-          & chunks as_ns-          & zip3 (map shapeDims as_ws) as_inps+        groupScatterResults (zip3 as_ws as_ns as_inps) (is' ++ vs)           & map (inPlaceReturn ispace)           & KernelBody () k_body_stms @@ -825,7 +821,7 @@      inPlaceReturn ispace (aw, inp, is_vs) =       WriteReturns-        (Shape (init ws ++ aw))+        (Shape (init ws ++ shapeDims aw))         (kernelInputArray inp)         [(map DimFix $ map Var (init gtids) ++ is, v) | (is, v) <- is_vs]       where@@ -1013,7 +1009,7 @@  isVectorMap :: Lambda SOACS -> (Shape, Lambda SOACS) isVectorMap lam-  | [Let (Pattern [] pes) _ (Op (Screma w form arrs))] <-+  | [Let (Pattern [] pes) _ (Op (Screma w arrs form))] <-       stmsToList $ bodyStms $ lambdaBody lam,     bodyResult (lambdaBody lam) == map (Var . patElemName) pes,     Just map_lam <- isMapSOAC form,

@@ -52,7 +52,7 @@           mkBody             ( oneStm $                 Let (setPatternOuterDimTo w map_pat) (defAux ()) $-                  Op $ Screma w scan_soac scan_arrs+                  Op $ Screma w scan_arrs scan_soac             )             $ map Var $ patternNames map_pat         map_fun' = Lambda map_params map_body map_rettype@@ -64,11 +64,7 @@      addStm $       Let res_pat' (StmAux map_cs mempty ()) $-        Op $-          Screma-            map_w-            (mapSOAC map_fun')-            map_arrs'+        Op $ Screma map_w map_arrs' (mapSOAC map_fun')      forM_       ( zip@@ -128,7 +124,7 @@             mkBody               ( oneStm $                   Let red_pat (defAux ()) $-                    Op $ Screma w reduce_soac $ map snd red_input'+                    Op $ Screma w (map snd red_input') reduce_soac               )               $ map Var $ patternNames map_pat         Just m -> localScope (scopeOfLParams map_params) $ do@@ -139,7 +135,7 @@      addStm $       Let res_pat (StmAux map_cs mempty ()) $-        Op $ Screma map_w (mapSOAC map_fun') arrs'+        Op $ Screma map_w arrs' $ mapSOAC map_fun'   | otherwise = Nothing  -- | Does this reduce operator contain an inner map, and if so, what@@ -152,7 +148,7 @@     [bnd] <- stmsToList stms, -- Body has a single binding     map_pat <- stmPattern bnd,     map Var (patternNames map_pat) == res, -- Returned verbatim-    Op (Screma map_w form map_arrs) <- stmExp bnd,+    Op (Screma map_w map_arrs form) <- stmExp bnd,     Just map_fun <- isMapSOAC form,     map paramName (lambdaParams fun) == map_arrs =     Just (map_pat, stmCerts bnd, map_w, map_fun)

@@ -72,7 +72,7 @@     let lam = Lambda (params' <> new_params) body rettype         map_bnd =           Let loop_pat_expanded aux $-            Op $ Screma w (mapSOAC lam) $ arrs' <> new_arrs+            Op $ Screma w (arrs' <> new_arrs) (mapSOAC lam)         res = map Var $ patternNames loop_pat_expanded         pat' = Pattern [] $ rearrangeShape perm $ patternValueElements pat @@ -155,7 +155,7 @@         mkBranch branch = (renameBody =<<) $ do           let lam = Lambda params branch lam_ret               res = map Var $ patternNames branch_pat'-              map_bnd = Let branch_pat' aux $ Op $ Screma w (mapSOAC lam) arrs+              map_bnd = Let branch_pat' aux $ Op $ Screma w arrs $ mapSOAC lam           return $ mkBody (oneStm map_bnd) res      tbranch' <- mkBranch tbranch

@@ -10,7 +10,6 @@ import Control.Monad.Identity import Control.Monad.RWS import Control.Monad.Trans.Maybe-import Data.Function ((&)) import qualified Data.Map.Strict as M import qualified Data.Set as S import Futhark.Analysis.PrimExp.Convert@@ -24,7 +23,6 @@ import Futhark.Pass.ExtractKernels.ToKernels import Futhark.Tools import qualified Futhark.Transform.FirstOrderTransform as FOT-import Futhark.Util (chunks) import Futhark.Util.Log import Prelude hiding (log) @@ -204,7 +202,7 @@       | "sequential_outer" `inAttrs` stmAuxAttrs aux ->         intraGroupStms lvl . fmap (certify (stmAuxCerts aux))           =<< runBinder_ (FOT.transformSOAC pat soac)-    Op (Screma w form arrs)+    Op (Screma w arrs form)       | Just lam <- isMapSOAC form -> do         let loopnest = MapNesting pat aux w $ zip (lambdaParams lam) arrs             env =@@ -235,7 +233,7 @@          addStms           =<< runDistNestT env (distributeMapBodyStms acc (bodyStms $ lambdaBody lam))-    Op (Screma w form arrs)+    Op (Screma w arrs form)       | Just (scans, mapfun) <- isScanomapSOAC form,         Scan scanfun nes <- singleScan scans -> do         let scanfun' = soacsLambdaToKernels scanfun@@ -243,7 +241,7 @@         certifying (stmAuxCerts aux) $           addStms =<< segScan lvl' pat w [SegBinOp Noncommutative scanfun' nes mempty] mapfun' arrs [] []         parallelMin [w]-    Op (Screma w form arrs)+    Op (Screma w arrs form)       | Just (reds, map_lam) <- isRedomapSOAC form,         Reduce comm red_lam nes <- singleReduce reds -> do         let red_lam' = soacsLambdaToKernels red_lam@@ -261,7 +259,7 @@       certifying (stmAuxCerts aux) $         addStms =<< segHist lvl' pat w [] [] ops' bucket_fun' arrs       parallelMin [w]-    Op (Stream w Sequential lam accs arrs)+    Op (Stream w arrs Sequential accs lam)       | chunk_size_param : _ <- lambdaParams lam -> do         types <- asksScope castScope         ((), stream_bnds) <-@@ -276,14 +274,10 @@       space <- mkSegSpace [(write_i, w)]        let lam' = soacsLambdaToKernels lam-          (dests_ws, dests_ns, dests_vs) = unzip3 dests-          indexes = zipWith (*) dests_ns $ map length dests_ws-          (i_res, v_res) = splitAt (sum indexes) $ bodyResult $ lambdaBody lam'+          (dests_ws, _, _) = unzip3 dests           krets = do             (a_w, a, is_vs) <--              zip (chunks (concat $ zipWith (\ws n -> replicate n $ length ws) dests_ws dests_ns) i_res) v_res-                & chunks dests_ns-                & zip3 dests_ws dests_vs+              groupScatterResults dests $ bodyResult $ lambdaBody lam'             return $ WriteReturns a_w a [(map DimFix is, v) | (is, v) <- is_vs]           inputs = do             (p, p_a) <- zip (lambdaParams lam') ivs

@@ -7,7 +7,6 @@ import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State-import Data.Function ((&)) import Futhark.Analysis.Rephrase import Futhark.IR import Futhark.IR.MC@@ -28,7 +27,7 @@ import Futhark.Tools import qualified Futhark.Transform.FirstOrderTransform as FOT import Futhark.Transform.Rename (Rename, renameSomething)-import Futhark.Util (chunks, takeLast)+import Futhark.Util (takeLast) import Futhark.Util.Log  newtype ExtractM a = ExtractM (ReaderT (Scope MC) (State VNameSource) a)@@ -274,7 +273,7 @@   return (red_stms, op)  transformSOAC :: Pattern SOACS -> Attrs -> SOAC SOACS -> ExtractM (Stms MC)-transformSOAC pat _ (Screma w form arrs)+transformSOAC pat _ (Screma w arrs form)   | Just lam <- isMapSOAC form = do     seq_op <- transformMap DoNotRename sequentialiseBody w lam arrs     if lambdaContainsParallelism lam@@ -318,15 +317,10 @@    Body () kstms res <- mapLambdaToBody transformBody gtid lam ivs -  let (dests_ws, dests_ns, dests_vs) = unzip3 dests-      indexes = zipWith (*) dests_ns $ map length dests_ws-      (i_res, v_res) = splitAt (sum indexes) res-      rets = takeLast (length dests) $ lambdaReturnType lam+  let rets = takeLast (length dests) $ lambdaReturnType lam       kres = do         (a_w, a, is_vs) <--          zip (chunks (concat $ zipWith (\ws n -> replicate n $ length ws) dests_ws dests_ns) i_res) v_res-            & chunks dests_ns-            & zip3 dests_ws dests_vs+          groupScatterResults dests res         return $ WriteReturns a_w a [(map DimFix is, v) | (is, v) <- is_vs]       kbody = KernelBody () kstms kres   return $@@ -350,7 +344,7 @@       return $         mconcat seq_hist_stms           <> oneStm (Let pat (defAux ()) $ Op $ ParOp Nothing seq_op)-transformSOAC pat attrs (Stream w (Parallel _ comm red_lam) fold_lam red_nes arrs)+transformSOAC pat attrs (Stream w arrs (Parallel _ comm red_lam) red_nes fold_lam)   | not $ null red_nes = do     map_lam <- unstreamLambda attrs red_nes fold_lam     (seq_red_stms, seq_op) <-@@ -367,15 +361,7 @@     if lambdaContainsParallelism map_lam       then do         (par_red_stms, par_op) <--          transformParStream-            DoRename-            transformBody-            w-            comm-            red_lam-            red_nes-            map_lam-            arrs+          transformParStream DoRename transformBody w comm red_lam red_nes map_lam arrs         return $           seq_red_stms <> par_red_stms             <> oneStm (Let pat (defAux ()) $ Op $ ParOp (Just par_op) seq_op)@@ -383,7 +369,7 @@         return $           seq_red_stms             <> oneStm (Let pat (defAux ()) $ Op $ ParOp Nothing seq_op)-transformSOAC pat _ (Stream w _ lam nes arrs) = do+transformSOAC pat _ (Stream w arrs _ nes lam) = do   -- Just remove the stream and transform the resulting stms.   soacs_scope <- castScope <$> askScope   stream_stms <-

@@ -81,16 +81,21 @@       | otherwise = Nothing  transformStm :: ExpMap -> Stm Kernels -> BabysitM ExpMap-transformStm expmap (Let pat aux (Op (SegOp op))) = do-  let mapper =-        identitySegOpMapper-          { mapOnSegOpBody =-              transformKernelBody expmap (segLevel op) (segSpace op)-          }-  op' <- mapSegOpM mapper op-  let stm' = Let pat aux $ Op $ SegOp op'-  addStm stm'-  return $ M.fromList [(name, stm') | name <- patternNames pat] <> expmap+transformStm expmap (Let pat aux (Op (SegOp op)))+  -- FIXME: We only make coalescing optimisations for SegThread+  -- SegOps, because that's what the analysis assumes.  For SegGroup+  -- we should probably look at the component SegThreads, but it+  -- apparently hasn't come up in practice yet.+  | SegThread {} <- segLevel op = do+    let mapper =+          identitySegOpMapper+            { mapOnSegOpBody =+                transformKernelBody expmap (segLevel op) (segSpace op)+            }+    op' <- mapSegOpM mapper op+    let stm' = Let pat aux $ Op $ SegOp op'+    addStm stm'+    return $ M.fromList [(name, stm') | name <- patternNames pat] <> expmap transformStm expmap (Let pat aux e) = do   e' <- mapExpM (transform expmap) e   let bnd' = Let pat aux e'

@@ -47,8 +47,6 @@ import qualified Futhark.Test.Values.Parser as V import Futhark.Util (nubOrd) import Futhark.Util.Pretty hiding (float, line, sep, string, (</>), (<|>))-import Language.Futhark.Prop (primValueType)-import Language.Futhark.Syntax (PrimValue (..)) import System.IO import System.IO.Temp import Text.Megaparsec@@ -76,7 +74,7 @@ -- all this is meant for. data Exp   = Call Func [Exp]-  | Const PrimValue+  | Const V.Value   | Tuple [Exp]   | Record [(T.Text, Exp)]   | StringLit T.Text@@ -121,7 +119,7 @@     [ inParens sep (mkTuple <$> (parseExp sep `sepBy` pComma)),       inBraces sep (Record <$> (pField `sepBy` pComma)),       Call <$> lexeme sep parseFunc <*> many (parseExp sep),-      Const <$> lexeme sep V.parsePrimValue,+      constV =<< lexeme sep V.parsePrimValue,       StringLit . T.pack <$> lexeme sep ("\"" *> manyTill charLiteral "\"")     ]   where@@ -142,6 +140,9 @@       where         constituent c = isAlphaNum c || c == '_' +    constV v =+      maybe (fail "invalid value read") (pure . Const) $ V.putValue v+ prettyFailure :: CmdFailure -> T.Text prettyFailure (CmdFailure bef aft) =   T.unlines $ bef ++ aft@@ -217,13 +218,9 @@ data ValOrVar = VVal V.Value | VVar VarName   deriving (Show) --- | The intermediate values used during expression evaluation - in+-- | The intermediate values produced by an expression - in -- particular, these may not be on the server.-type InterValue = V.Compound (ScriptValue ValOrVar)---- | The value that is produced by expression evaluation.  This--- representation keeps all values on the server.-type ExpValue = V.Compound (ScriptValue VarName)+type ExpValue = V.Compound (ScriptValue ValOrVar)  -- | The type of a 'ScriptValue'. scriptValueType :: ScriptValue v -> ScriptValueType@@ -233,13 +230,16 @@ serverVarsInValue :: ExpValue -> S.Set VarName serverVarsInValue = S.fromList . concatMap isVar . toList   where-    isVar (SValue _ x) = [x]+    isVar (SValue _ (VVar x)) = [x]+    isVar (SValue _ (VVal _)) = []     isVar (SFun _ _ _ closure) = concatMap isVar $ toList closure  -- | Convert a value into a corresponding expression. valueToExp :: ExpValue -> Exp-valueToExp (V.ValueAtom (SValue t v)) =+valueToExp (V.ValueAtom (SValue t (VVar v))) =   ServerVar t v+valueToExp (V.ValueAtom (SValue _ (VVal v))) =+  Const v valueToExp (V.ValueAtom (SFun fname _ _ closure)) =   Call (FuncFut fname) $ map (valueToExp . V.ValueAtom) closure valueToExp (V.ValueRecord fs) =@@ -251,7 +251,13 @@ type EvalBuiltin m = T.Text -> [V.CompoundValue] -> m V.CompoundValue  -- | Evaluate a FutharkScript expression relative to some running server.-evalExp :: forall m. (MonadError T.Text m, MonadIO m) => EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue+evalExp ::+  forall m.+  (MonadError T.Text m, MonadIO m) =>+  EvalBuiltin m ->+  ScriptServer ->+  Exp ->+  m ExpValue evalExp builtin (ScriptServer server counter) top_level_e = do   vars <- liftIO $ newIORef []   let newVar base = liftIO $ do@@ -283,24 +289,21 @@       scriptValueToVar :: ScriptValue ValOrVar -> m VarName       scriptValueToVar = toVar <=< scriptValueToValOrVar -      interValToVal :: InterValue -> m V.CompoundValue+      interValToVal :: ExpValue -> m V.CompoundValue       interValToVal = traverse scriptValueToVal -      interValToVar :: InterValue -> m VarName+      interValToVar :: ExpValue -> m VarName       interValToVar (V.ValueAtom v) = scriptValueToVar v       interValToVar _ = throwError "Unexpected tuple or record value." -      valToInterVal :: V.CompoundValue -> InterValue+      valToInterVal :: V.CompoundValue -> ExpValue       valToInterVal = fmap $ \v ->-        SValue (prettyText (V.valueType v)) $ VVal v--      interValToExpVal :: InterValue -> m ExpValue-      interValToExpVal = traverse (traverse toVar)+        SValue (V.prettyValueTypeNoDims (V.valueType v)) $ VVal v        simpleType (V.ValueAtom (STValue _)) = True       simpleType _ = False -      evalExp' :: Exp -> m InterValue+      evalExp' :: Exp -> m ExpValue       evalExp' (ServerVar t v) =         pure $ V.ValueAtom $ SValue t $ VVar v       evalExp' (Call (FuncBuiltin name) es) = do@@ -322,9 +325,9 @@         unless (and $ zipWith (==) es_types (map (V.ValueAtom . STValue) in_types)) $           throwError $             "Function \"" <> name <> "\" expects arguments of types:\n"-              <> prettyText (V.ValueTuple $ map V.ValueAtom in_types)+              <> prettyText (V.mkCompound $ map V.ValueAtom in_types)               <> "\nBut called with arguments of types:\n"-              <> prettyText (V.ValueTuple $ map V.ValueAtom es_types)+              <> prettyText (V.mkCompound $ map V.ValueAtom es_types)          ins <- mapM (interValToVar <=< evalExp') es @@ -342,10 +345,7 @@             pure $ V.ValueAtom $ SValue (prettyText (V.valueType s')) $ VVal s'           Nothing -> error $ "Unable to write value " ++ pretty s       evalExp' (Const val) =-        case V.putValue val of-          Just val' ->-            pure $ V.ValueAtom $ SValue (prettyText (primValueType val)) $ VVal val'-          Nothing -> error $ "Unable to write value " ++ pretty 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@@ -366,15 +366,17 @@         -- Call.         void $ liftIO $ cmdFree server =<< readIORef vars         throwError e-  (freeNonresultVars =<< interValToExpVal =<< evalExp' top_level_e) `catchError` freeVarsOnError+  (freeNonresultVars =<< evalExp' top_level_e) `catchError` freeVarsOnError  -- | Read actual values from the server.  Fails for values that have -- no well-defined external representation. getExpValue ::   (MonadError T.Text m, MonadIO m) => ScriptServer -> ExpValue -> m V.CompoundValue getExpValue (ScriptServer server _) e =-  traverse toGround =<< traverse (traverse (readVar server)) e+  traverse toGround =<< traverse (traverse onLeaf) e   where+    onLeaf (VVar v) = readVar server v+    onLeaf (VVal v) = pure v     toGround (SFun fname _ _ _) =       throwError $ "Function " <> fname <> " not fully applied."     toGround (SValue _ v) = pure v

@@ -15,6 +15,7 @@     getValues,     getValuesBS,     withValuesFile,+    checkValueTypes,     compareValues,     checkResult,     testRunReferenceOutput,@@ -511,8 +512,9 @@ getValuesBS futhark dir (GenValues gens) =   mconcat <$> mapM (getGenBS futhark dir) gens --- | Evaluate an IO action while the values are available in a file by--- some name.  The file will be removed after the action is done.+-- | 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 =>   FutharkExe ->@@ -525,9 +527,26 @@     liftIO $ f $ dir </> file withValuesFile futhark dir vs f =   liftIO . withSystemTempFile "futhark-input" $ \tmpf tmpf_h -> do-    BS.hPutStr tmpf_h =<< getValuesBS futhark dir vs+    mapM_ (BS.hPutStr tmpf_h . Bin.encode) =<< getValues futhark dir 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+            ]  -- | There is a risk of race conditions when multiple programs have -- identical 'GenValues'.  In such cases, multiple threads in 'futhark

@@ -20,6 +20,7 @@      -- * Types of values     ValueType (..),+    prettyValueTypeNoDims,     valueType,     valueShape, @@ -239,6 +240,12 @@   ppr (ValueType ds t) = mconcat (map pprDim ds) <> ppr t     where       pprDim d = brackets $ ppr d++-- | Prettyprint a value type with empty dimensions.  This is needed+-- for Futhark server programs, whose types are un-sized.+prettyValueTypeNoDims :: ValueType -> T.Text+prettyValueTypeNoDims (ValueType dims t) =+  mconcat (replicate (length dims) "[]") <> prettyText t  -- | Get the type of a value. valueType :: Value -> ValueType

@@ -49,11 +49,11 @@   (w, comm, redlam, map_lam, accs, arrs) = do     (map_pat, red_pat, red_args) <-       splitScanOrRedomap patelems w map_lam accs-    let map_bnd = mkLet [] map_pat $ Op $ Screma w (mapSOAC map_lam) arrs+    let map_bnd = mkLet [] map_pat $ Op $ Screma w arrs (mapSOAC map_lam)         (nes, red_arrs) = unzip red_args     red_bnd <-       Let red_pat (defAux ()) . Op-        <$> (Screma w <$> reduceSOAC [Reduce comm redlam nes] <*> pure red_arrs)+        <$> (Screma w red_arrs <$> reduceSOAC [Reduce comm redlam nes])     return (map_bnd, red_bnd) redomapToMapAndReduce _ _ =   error "redomapToMapAndReduce does not handle a non-empty 'patternContextElements'"@@ -102,10 +102,10 @@    let scanomap = scanomapSOAC scans map_lam   letBindNames (scan_res <> to_red <> map_res) $-    Op $ Screma w scanomap arrs+    Op $ Screma w arrs scanomap    reduce <- reduceSOAC reds-  letBindNames red_res $ Op $ Screma w reduce to_red+  letBindNames red_res $ Op $ Screma w to_red reduce  -- | Turn a stream SOAC into statements that apply the stream lambda -- to the entire input.

@@ -20,7 +20,6 @@  import Control.Monad.Except import Control.Monad.State-import Data.Function ((&)) import Data.List (zip4) import qualified Data.Map.Strict as M import qualified Futhark.IR as AST@@ -110,7 +109,7 @@   AST.Pattern (Lore m) ->   SOAC (Lore m) ->   m ()-transformSOAC pat (Screma w form@(ScremaForm scans reds map_lam) arrs) = do+transformSOAC pat (Screma w arrs form@(ScremaForm scans reds map_lam)) = do   -- Start by combining all the reduction parts into a single operator   let Reduce _ red_lam red_nes = singleReduce reds       Scan scan_lam scan_nes = singleScan scans@@ -197,7 +196,7 @@     (++ patternNames pat)       <$> replicateM (length scanacc_params) (newVName "discard")   letBindNames names $ DoLoop [] merge loopform loop_body-transformSOAC pat (Stream w _ lam nes arrs) = do+transformSOAC pat (Stream w arrs _ nes lam) = do   -- Create a loop that repeatedly applies the lambda body to a   -- chunksize of 1.  Hopefully this will lead to this outer loop   -- being the only one, as all the innermost one can be simplified@@ -259,8 +258,6 @@   ts <- mapM lookupType as_vs   asOuts <- mapM (newIdent "write_out") ts -  let ivsLen = zipWith (*) as_ns $ map length as_ws-   -- Scatter is in-place, so we use the input array as the output array.   let merge = loopMerge asOuts $ map Var as_vs   loopBody <- runBodyBinder $@@ -274,17 +271,13 @@           letSubExp "write_iv" $ BasicOp $ Index iv $ fullSlice iv_t [DimFix $ Var iter]         ivs'' <- bindLambda lam (map (BasicOp . SubExp) ivs') -        let indexes =-              take (sum ivsLen) ivs''-                & chunks (concat $ zipWith (\ws n -> replicate n (length ws)) as_ws as_ns)-                & chunks as_ns-            values = chunks as_ns $ drop (sum ivsLen) ivs''+        let indexes = groupScatterResults (zip3 as_ws as_ns $ map identName asOuts) ivs'' -        ress <- forM (zip3 indexes values (map identName asOuts)) $ \(indexes', values', arr) -> do+        ress <- forM indexes $ \(_, arr, indexes') -> do           let saveInArray arr' (indexCur, valueCur) =                 letExp "write_out" =<< eWriteArray arr' (map eSubExp indexCur) (eSubExp valueCur) -          foldM saveInArray arr $ zip indexes' values'+          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

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Strict #-} {-# LANGUAGE Trustworthy #-}@@ -63,7 +64,7 @@ import Futhark.Construct (instantiateShapes) import Futhark.IR.Aliases hiding (lookupAliases) import Futhark.Util-import Futhark.Util.Pretty (Pretty, align, indent, ppr, prettyDoc, text, (<+>))+import Futhark.Util.Pretty (Pretty, align, indent, ppr, prettyDoc, text, (<+>), (</>))  -- | Information about an error during type checking.  The 'Show' -- instance for this type produces a human-readable description.@@ -687,7 +688,7 @@ checkStms origbnds m = delve $ stmsToList origbnds   where     delve (stm@(Let pat _ e) : bnds) = do-      context ("In expression of statement " ++ pretty pat) $+      context (pretty $ "In expression of statement" </> indent 2 (ppr pat)) $         checkExp e       checkStm stm $         delve bnds@@ -1294,7 +1295,14 @@           checkLambdaParams params           mapM_ checkType rettype           checkLambdaBody rettype body-    else bad $ TypeError $ "Anonymous function defined with " ++ show (length params) ++ " parameters, but expected to take " ++ show (length args) ++ " arguments."+    else+      bad $+        TypeError $+          "Anonymous function defined with " ++ show (length params) ++ " parameters:\n"+            ++ pretty params+            ++ "\nbut expected to take "+            ++ show (length args)+            ++ " arguments."  checkPrimExp :: Checkable lore => PrimExp VName -> TypeM lore () checkPrimExp ValueExp {} = return ()

@@ -43,6 +43,7 @@     toPOSIX,     trim,     pmapIO,+    readFileSafely,     UserString,     EncodedString,     zEncodeString,@@ -61,6 +62,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T+import qualified Data.Text.IO as T import Numeric import qualified System.Directory.Tree as Dir import System.Environment@@ -68,6 +70,7 @@ import qualified System.FilePath as Native import qualified System.FilePath.Posix as Posix import System.IO (hIsTerminalDevice, stdout)+import System.IO.Error (isDoesNotExistError) import System.IO.Unsafe import System.Process.ByteString import Text.Printf@@ -319,6 +322,18 @@       case res of         Left err -> throw (err :: SomeException)         Right v -> pure v++-- | Read a file, returning 'Nothing' if the file does not exist, and+-- 'Left' if some other error occurs.+readFileSafely :: FilePath -> IO (Maybe (Either String T.Text))+readFileSafely filepath =+  (Just . Right <$> T.readFile filepath) `catch` couldNotRead+  where+    couldNotRead e+      | isDoesNotExistError e =+        return Nothing+      | otherwise =+        return $ Just $ Left $ show e  -- Z-encoding from https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/SymbolNames --

@@ -892,7 +892,7 @@                  ]                  uarr_3d_a              ),-             ("zip", IntrinsicPolyFun [tp_a, tp_b] [arr_a, arr_b] arr_a_b),+             ("zip", IntrinsicPolyFun [tp_a, tp_b] [arr_a, arr_b] uarr_a_b),              ("unzip", IntrinsicPolyFun [tp_a, tp_b] [arr_a_b] t_arr_a_arr_b),              ( "hist",                IntrinsicPolyFun@@ -989,6 +989,7 @@         Nonunique         (Record (M.fromList $ zip tupleFieldNames [Scalar t_a, Scalar t_b]))         (rank 1)+    uarr_a_b = arr_a_b `setUniqueness` Unique     t_arr_a_arr_b = Scalar $ Record $ M.fromList $ zip tupleFieldNames [arr_a, arr_b]      arr x y = Scalar $ Arrow mempty Unnamed x y