futhark 0.16.2 → 0.16.3

raw patch · 40 files changed

+316/−121 lines, 40 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• docs/language-reference.rst +1/−1
• docs/man/futhark-test.rst +2/−2
• docs/usage.rst +10/−2
• futhark.cabal +1/−1
• prelude/array.fut +2/−2
• prelude/math.fut +13/−0
• rts/c/cuda.h +21/−5
• rts/c/opencl.h +2/−3
• rts/c/values.h +1/−1
• rts/python/opencl.py +1/−1
• rts/python/scalar.py +11/−0
• src/Futhark/Analysis/PrimExp.hs +29/−0
• src/Futhark/Analysis/SymbolTable.hs +5/−6
• src/Futhark/CodeGen/Backends/CCUDA.hs +1/−1
• src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs +2/−2
• src/Futhark/CodeGen/Backends/COpenCL.hs +0/−5
• src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs +8/−3
• src/Futhark/CodeGen/Backends/GenericC.hs +33/−12
• src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs +4/−5
• src/Futhark/CodeGen/Backends/SimpleRep.hs +56/−1
• src/Futhark/CodeGen/ImpCode.hs +1/−1
• src/Futhark/CodeGen/ImpGen.hs +3/−4
• src/Futhark/CodeGen/ImpGen/Kernels.hs +6/−9
• src/Futhark/CodeGen/ImpGen/Kernels/Base.hs +5/−5
• src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs +10/−15
• src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs +2/−2
• src/Futhark/Doc/Generator.hs +5/−3
• src/Futhark/IR/Kernels/Kernel.hs +5/−3
• src/Futhark/IR/Kernels/Sizes.hs +10/−2
• src/Futhark/IR/Mem/Simplify.hs +1/−2
• src/Futhark/IR/Primitive.hs +5/−0
• src/Futhark/Internalise.hs +1/−1
• src/Futhark/Optimise/CSE.hs +15/−0
• src/Futhark/Optimise/Simplify/Rules.hs +2/−2
• src/Futhark/Pass/ExpandAllocations.hs +1/−1
• src/Futhark/Pass/ExplicitAllocations.hs +6/−8
• src/Futhark/Pass/ExtractKernels.hs +16/−7
• src/Futhark/Test.hs +17/−1
• src/Language/Futhark/Parser/Lexer.x +1/−1
• src/Language/Futhark/TypeChecker/Types.hs +1/−1

@@ -79,7 +79,7 @@    binary: 0 ("b" | "B") `bindigit` (`bindigit` | "_")*  .. productionlist::-   floatnumber: (`pointfloat` | `exponentfloat`) [`float_type`]+   floatnumber: (`pointfloat` | `exponentfloat` | `hexadecimalfloat`) [`float_type`]    pointfloat: [`intpart`] `fraction`    exponentfloat: (`intpart` | `pointfloat`) `exponent`    hexadecimalfloat: 0 ("x" | "X") `hexintpart` `hexfraction` ("p"|"P") ["+" | "-"] `decdigit`+

@@ -50,8 +50,8 @@ the case of arrays.  When ``futhark test`` is run, a file located in a ``data/`` subdirectory, containing values of the indicated types and shapes is, automatically constructed with ``futhark-dataset``.  Apart-from sizes, integer constants (with or without type suffix) are also-permitted.+from sizes, integer constants (with or without type suffix), and+floating-point constants (always with type suffix) are also permitted.  If ``input`` is followed by an ``@`` and a file name (which must not contain any whitespace) instead of curly braces, values will be read

@@ -107,9 +107,15 @@ ~~~~~~~~~~~~~~~~  The following options are supported by executables generated with the-parallel backends (``opencl``, ``pyopencl``, ``csopencl``, and+GPU backends (``opencl``, ``pyopencl``, ``csopencl``, and ``cuda``). +  ``-d DEVICE``++    Pick the first device whose name contains the given string.  The+    special string ``#k``, where ``k`` is an integer, can be used to+    pick the *k*-th device, numbered from zero.+   ``--tuning=FILE``      Load tuning options from the indicated *tuning file*.  The file@@ -149,7 +155,9 @@      Pick the first OpenCL platform whose name contains the given     string.  The special string ``#k``, where ``k`` is an integer, can-    be used to pick the *k*-th platform, numbered from zero.+    be used to pick the *k*-th platform, numbered from zero.  If used+    in conjunction with ``-d``, only the devices from matching+    platforms are considered.    ``-d DEVICE`` 

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:           futhark-version:        0.16.2+version:        0.16.3 synopsis:       An optimising compiler for a functional, array-oriented language.  description:    Futhark is a small programming language designed to be compiled to

@@ -107,11 +107,11 @@  -- | True if all of the input elements are true.  Produces true on an -- empty array.-let and: []bool -> bool = all id+let and [n] (xs: [n]bool) = all id xs  -- | True if any of the input elements are true.  Produces false on an -- empty array.-let or: []bool -> bool = any id+let or [n] (xs: [n]bool) = any id xs  -- | Perform a *sequential* left-fold of an array. let foldl [n] 'a 'b (f: a -> b -> a) (acc: a) (bs: [n]b): a =

@@ -111,6 +111,11 @@   -- | Count number of zero bits preceding the most significant set   -- bit.   val clz: t -> i32++  -- | Count number of trailing zero bits following the least+  -- significant set bit.  Returns the number of bits in the type if+  -- the argument is all-zero.+  val ctz: t -> i32 }  -- | An extension of `size`@mtype that further includes facilities for@@ -298,6 +303,7 @@   let mul_hi a b = intrinsics.mul_hi8 (i8 a, i8 b)   let mad_hi a b c = intrinsics.mad_hi8 (i8 a, i8 b, i8 c)   let clz = intrinsics.clz8+  let ctz = intrinsics.ctz8    let iota (n: i8) = 0i8..1i8..<n   let replicate 'v (n: i8) (x: v) = map (const x) (iota n)@@ -372,6 +378,7 @@   let mul_hi a b = intrinsics.mul_hi16 (i16 a, i16 b)   let mad_hi a b c = intrinsics.mad_hi16 (i16 a, i16 b, i16 c)   let clz = intrinsics.clz16+  let ctz = intrinsics.ctz16    let iota (n: i16) = 0i16..1i16..<n   let replicate 'v (n: i16) (x: v) = map (const x) (iota n)@@ -449,6 +456,7 @@   let mul_hi a b = intrinsics.mul_hi32 (i32 a, i32 b)   let mad_hi a b c = intrinsics.mad_hi32 (i32 a, i32 b, i32 c)   let clz = intrinsics.clz32+  let ctz = intrinsics.ctz32    let iota (n: i32) = 0..1..<n   let replicate 'v (n: i32) (x: v) = map (const x) (iota n)@@ -526,6 +534,7 @@   let mul_hi a b = intrinsics.mul_hi64 (i64 a, i64 b)   let mad_hi a b c = intrinsics.mad_hi64 (i64 a, i64 b, i64 c)   let clz = intrinsics.clz64+  let ctz = intrinsics.ctz64    let iota (n: i64) = 0i64..1i64..<n   let replicate 'v (n: i64) (x: v) = map (const x) (iota n)@@ -603,6 +612,7 @@   let mul_hi a b = unsign (intrinsics.mul_hi8 (sign a, sign b))   let mad_hi a b c = unsign (intrinsics.mad_hi8 (sign a, sign b, sign c))   let clz x = intrinsics.clz8 (sign x)+  let ctz x = intrinsics.ctz8 (sign x)    let iota (n: u8) = 0u8..1u8..<n   let replicate 'v (n: u8) (x: v) = map (const x) (iota n)@@ -680,6 +690,7 @@   let mul_hi a b = unsign (intrinsics.mul_hi16 (sign a, sign b))   let mad_hi a b c = unsign (intrinsics.mad_hi16 (sign a, sign b, sign c))   let clz x = intrinsics.clz16 (sign x)+  let ctz x = intrinsics.ctz16 (sign x)    let iota (n: u16) = 0u16..1u16..<n   let replicate 'v (n: u16) (x: v) = map (const x) (iota n)@@ -757,6 +768,7 @@   let mul_hi a b = unsign (intrinsics.mul_hi32 (sign a, sign b))   let mad_hi a b c = unsign (intrinsics.mad_hi32 (sign a, sign b, sign c))   let clz x = intrinsics.clz32 (sign x)+  let ctz x = intrinsics.ctz32 (sign x)    let iota (n: u32) = 0u32..1u32..<n   let replicate 'v (n: u32) (x: v) = map (const x) (iota n)@@ -834,6 +846,7 @@   let mul_hi a b = unsign (intrinsics.mul_hi64 (sign a, sign b))   let mad_hi a b c = unsign (intrinsics.mad_hi64 (sign a, sign b, sign c))   let clz x = intrinsics.clz64 (sign x)+  let ctz x = intrinsics.ctz64 (sign x)    let iota (n: u64) = 0u64..1u64..<n   let replicate 'v (n: u64) (x: v) = map (const x) (iota n)

@@ -27,6 +27,7 @@   int debugging;   int logging;   const char *preferred_device;+  int preferred_device_num;    const char *dump_program_to;   const char *load_program_from;@@ -58,8 +59,8 @@                              const char *size_classes[]) {   cfg->debugging = 0;   cfg->logging = 0;+  cfg->preferred_device_num = 0;   cfg->preferred_device = "";-   cfg->dump_program_to = NULL;   cfg->load_program_from = NULL; @@ -129,7 +130,19 @@ }  static void set_preferred_device(struct cuda_config *cfg, const char *s) {+  int x = 0;+  if (*s == '#') {+    s++;+    while (isdigit(*s)) {+      x = x * 10 + (*s++)-'0';+    }+    // Skip trailing spaces.+    while (isspace(*s)) {+      s++;+    }+  }   cfg->preferred_device = s;+  cfg->preferred_device_num = x; }  static int cuda_device_setup(struct cuda_context *ctx) {@@ -142,6 +155,8 @@   CUDA_SUCCEED(cuDeviceGetCount(&count));   if (count == 0) { return 1; } +  int num_device_matches = 0;+   // XXX: Current device selection policy is to choose the device with the   // highest compute capability (if no preferred device is set).   // This should maybe be changed, since greater compute capability is not@@ -174,8 +189,10 @@       cc_minor_best = cc_minor;     } -    if (chosen == -1 && strstr(name, ctx->cfg.preferred_device) == name) {+    if (strstr(name, ctx->cfg.preferred_device) != NULL &&+        num_device_matches++ == ctx->cfg.preferred_device_num) {       chosen = i;+      break;     }   } @@ -372,7 +389,7 @@    for (int i = 0; i < ctx->cfg.num_sizes; i++) {     const char *size_class, *size_name;-    size_t *size_value, max_value, default_value;+    size_t *size_value, max_value = 0, default_value = 0;      size_class = ctx->cfg.size_classes[i];     size_value = &ctx->cfg.size_values[i];@@ -394,11 +411,10 @@       max_value = ctx->max_tile_size;       default_value = ctx->cfg.default_tile_size;     } else if (strstr(size_class, "threshold") == size_class) {-      max_value = ctx->max_threshold;+      // Threshold can be as large as it takes.       default_value = ctx->cfg.default_threshold;     } else {       // Bespoke sizes have no limit or default.-      max_value = 0;     }      if (*size_value == 0) {

@@ -566,7 +566,7 @@     const char *size_class = ctx->cfg.size_classes[i];     size_t *size_value = &ctx->cfg.size_values[i];     const char* size_name = ctx->cfg.size_names[i];-    size_t max_value, default_value;+    size_t max_value = 0, default_value = 0;     if (strstr(size_class, "group_size") == size_class) {       max_value = max_group_size;       default_value = ctx->cfg.default_group_size;@@ -583,11 +583,10 @@       max_value = sqrt(max_group_size);       default_value = ctx->cfg.default_tile_size;     } else if (strstr(size_class, "threshold") == size_class) {-      max_value = 0; // No limit.+      // Threshold can be as large as it takes.       default_value = ctx->cfg.default_threshold;     } else {       // Bespoke sizes have no limit or default.-      max_value = 0;     }     if (*size_value == 0) {       *size_value = default_value;

@@ -202,7 +202,7 @@      next_token(buf, bufsize); -    if (sscanf(buf, "%"SCNu64, &shape[i]) != 1) {+    if (sscanf(buf, "%"SCNu64, (uint64_t*)&shape[i]) != 1) {       return 1;     } 

@@ -68,7 +68,7 @@     for (platform_name, device_type, size, valuef) in size_heuristics:         if sizes[size] == None \            and self.platform.name.find(platform_name) >= 0 \-           and self.device.type == device_type:+           and (self.device.type & device_type) == device_type:                sizes[size] = valuef(self.device)     return sizes 

@@ -261,6 +261,16 @@     x <<= np.int8(1)   return n +def ctz_T(x):+  n = np.int32(0)+  bits = x.itemsize * 8+  for i in range(bits):+    if (x & 1) == 1:+      break+    n += 1+    x >>= np.int8(1)+  return n+ def popc_T(x):   c = np.int32(0)   while x != 0:@@ -270,6 +280,7 @@  futhark_popc8 = futhark_popc16 = futhark_popc32 = futhark_popc64 = popc_T futhark_clzz8 = futhark_clzz16 = futhark_clzz32 = futhark_clzz64 = clz_T+futhark_ctzz8 = futhark_ctzz16 = futhark_ctzz32 = futhark_ctzz64 = ctz_T  def ssignum(x):   return np.sign(x)

@@ -13,6 +13,7 @@   , constFoldPrimExp    , module Futhark.IR.Primitive+  , sExt, zExt   , (.&&.), (.||.), (.<.), (.<=.), (.>.), (.>=.), (.==.), (.&.), (.|.), (.^.)   ) where @@ -250,12 +251,40 @@ infixr 3 .&&. infixr 2 .||. +-- | Smart constructor for sign extension that does a bit of constant+-- folding.+sExt :: IntType -> PrimExp v -> PrimExp v+sExt it (ValueExp (IntValue v)) = ValueExp $ IntValue $ doSExt v it+sExt it e+  | primExpIntType e == it = e+  | otherwise = ConvOpExp (SExt (primExpIntType e) it) e++-- | Smart constructor for zero extension that does a bit of constant+-- folding.+zExt :: IntType -> PrimExp v -> PrimExp v+zExt it (ValueExp (IntValue v)) = ValueExp $ IntValue $ doZExt v it+zExt it e+  | primExpIntType e == it = e+  | otherwise = ConvOpExp (ZExt (primExpIntType e) it) e+ asIntOp :: (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v) asIntOp f x y+  -- If either of the operands is a constant, then we prefer the type+  -- of the other operand.  This lets us use literals via fromInteger+  -- without imposing a specific type.+  | ValueExp{} <- x,+    IntType y_t <- primExpType y,+    Just x' <- asIntExp y_t x = Just $ BinOpExp (f y_t) x' y+  | ValueExp{} <- y,+    IntType x_t <- primExpType x,+    Just y' <- asIntExp x_t y = Just $ BinOpExp (f x_t) x y'++  -- Otherwise prefer the type of the leftmost operand.   | IntType t <- primExpType x,     Just y' <- asIntExp t y = Just $ BinOpExp (f t) x y'   | IntType t <- primExpType y,     Just x' <- asIntExp t x = Just $ BinOpExp (f t) x' y+   | otherwise = Nothing  asIntExp :: IntType -> PrimExp v -> Maybe (PrimExp v)

@@ -271,12 +271,11 @@ indexExp vtable (Op op) k is =   indexOp vtable k op is -indexExp _ (BasicOp (Iota _ x s to_it)) _ [i]-  | IntType from_it <- primExpType i =-      Just $ Indexed mempty $-       ConvOpExp (SExt from_it to_it) i-       * primExpFromSubExp (IntType to_it) s-       + primExpFromSubExp (IntType to_it) x+indexExp _ (BasicOp (Iota _ x s to_it)) _ [i] =+  Just $ Indexed mempty $+  sExt to_it i+  * primExpFromSubExp (IntType to_it) s+  + primExpFromSubExp (IntType to_it) x  indexExp table (BasicOp (Replicate (Shape ds) v)) _ is   | length ds == length is,

@@ -204,7 +204,7 @@   let field = "max_" ++ cudaSizeClass size_class   in GC.stm [C.cstm|$id:v = ctx->cuda.$id:field;|]   where-    cudaSizeClass (SizeThreshold _) = "threshold"+    cudaSizeClass SizeThreshold{} = "threshold"     cudaSizeClass SizeGroup = "block_size"     cudaSizeClass SizeNumGroups = "grid_size"     cudaSizeClass SizeTile = "tile_size"

@@ -20,6 +20,7 @@ import Futhark.Util (chunk, zEncodeString)  import qualified Data.Map as M+import Data.Maybe import Data.FileEmbed (embedStringFile)  errorMsgNumArgs :: ErrorMsg a -> Int@@ -117,8 +118,7 @@    let size_value_inits = zipWith sizeInit [0..M.size sizes-1] (M.elems sizes)       sizeInit i size = [C.cstm|cfg->sizes[$int:i] = $int:val;|]-         where val = case size of SizeBespoke _ x -> x-                                  _               -> 0+         where val = fromMaybe 0 $ sizeDefault size   GC.publicDef_ "context_config_new" GC.InitDecl $ \s ->     ([C.cedecl|struct $id:cfg* $id:s(void);|],      [C.cedecl|struct $id:cfg* $id:s(void) {

@@ -67,11 +67,6 @@            , optionArgument = RequiredArgument "NAME"            , optionAction = [C.cstm|futhark_context_config_set_platform(cfg, optarg);|]            }-  , Option { optionLongName = "device"-           , optionShortName = Just 'd'-           , optionArgument = RequiredArgument "NAME"-           , optionAction = [C.cstm|futhark_context_config_set_device(cfg, optarg);|]-           }   , Option { optionLongName = "dump-opencl"            , optionShortName = Nothing            , optionArgument = RequiredArgument "FILE"

@@ -17,6 +17,7 @@ import Control.Monad.State import Data.FileEmbed import qualified Data.Map as M+import Data.Maybe import qualified Language.C.Syntax as C import qualified Language.C.Quote.OpenCL as C @@ -113,8 +114,7 @@    let size_value_inits = zipWith sizeInit [0..M.size sizes-1] (M.elems sizes)       sizeInit i size = [C.cstm|cfg->sizes[$int:i] = $int:val;|]-         where val = case size of SizeBespoke _ x -> x-                                  _               -> 0+         where val = fromMaybe 0 $ sizeDefault size   GC.publicDef_ "context_config_new" GC.InitDecl $ \s ->     ([C.cedecl|struct $id:cfg* $id:s(void);|],      [C.cedecl|struct $id:cfg* $id:s(void) {@@ -602,7 +602,12 @@ -- Options that are common to multiple GPU-like backends. commonOptions :: [Option] commonOptions =-   [ Option { optionLongName = "default-group-size"+   [ Option { optionLongName = "device"+            , optionShortName = Just 'd'+            , optionArgument = RequiredArgument "NAME"+            , optionAction = [C.cstm|futhark_context_config_set_device(cfg, optarg);|]+            }+   , Option { optionLongName = "default-group-size"             , optionShortName = Nothing             , optionArgument = RequiredArgument "INT"             , optionAction = [C.cstm|futhark_context_config_set_default_group_size(cfg, atoi(optarg));|]

@@ -1365,14 +1365,36 @@                      , cLib :: String                      } +-- We may generate variables that are never used (e.g. for+-- certificates) or functions that are never called (e.g. unused+-- intrinsics), and generated code may have other cosmetic issues that+-- compilers warn about.  We disable these warnings to not clutter the+-- compilation logs.+disableWarnings :: String+disableWarnings = pretty [C.cunit|+$esc:("#ifdef __GNUC__")+$esc:("#pragma GCC diagnostic ignored \"-Wunused-function\"")+$esc:("#pragma GCC diagnostic ignored \"-Wunused-variable\"")+$esc:("#pragma GCC diagnostic ignored \"-Wparentheses\"")+$esc:("#pragma GCC diagnostic ignored \"-Wunused-label\"")+$esc:("#endif")++$esc:("#ifdef __clang__")+$esc:("#pragma clang diagnostic ignored \"-Wunused-function\"")+$esc:("#pragma clang diagnostic ignored \"-Wunused-variable\"")+$esc:("#pragma clang diagnostic ignored \"-Wparentheses\"")+$esc:("#pragma clang diagnostic ignored \"-Wunused-label\"")+$esc:("#endif")+|]+ -- | Produce header and implementation files. asLibrary :: CParts -> (String, String) asLibrary parts = ("#pragma once\n\n" <> cHeader parts,-                   cHeader parts <> cUtils parts <> cLib parts)+                   disableWarnings <> cHeader parts <> cUtils parts <> cLib parts)  -- | As executable with command-line interface. asExecutable :: CParts -> String-asExecutable (CParts a b c d) = a <> b <> c <> d+asExecutable (CParts a b c d) = disableWarnings <> a <> b <> c <> d  -- | Compile imperative program to a C program.  Always uses the -- function named "main" as entry point, so make sure it is defined.@@ -1643,7 +1665,10 @@ compileConstants (Constants ps init_consts) = do   ctx_ty <- contextType   const_fields <- mapM constParamField ps-  contextField "constants" [C.cty|struct { $sdecls:const_fields }|] Nothing+  -- Avoid an empty struct, as that is apparently undefined behaviour.+  let const_fields' | null const_fields = [[C.csdecl|int dummy;|]]+                    | otherwise = const_fields+  contextField "constants" [C.cty|struct { $sdecls:const_fields' }|] Nothing   earlyDecl [C.cedecl|int init_constants($ty:ctx_ty*);|]   earlyDecl [C.cedecl|int free_constants($ty:ctx_ty*);|] @@ -2029,15 +2054,11 @@     _ ->       [C.cstm|if ($exp:cond') { $items:tbranch' } else { $items:fbranch' }|] -compileCode (Copy dest (Count destoffset) DefaultSpace src (Count srcoffset) DefaultSpace (Count size)) = do-  destoffset' <- compileExp destoffset-  srcoffset' <- compileExp srcoffset-  size' <- compileExp size-  dest' <- rawMem dest-  src' <- rawMem src-  stm [C.cstm|memmove($exp:dest' + $exp:destoffset',-                      $exp:src' + $exp:srcoffset',-                      $exp:size');|]+compileCode (Copy dest (Count destoffset) DefaultSpace src (Count srcoffset) DefaultSpace (Count size)) =+  join $ copyMemoryDefaultSpace+  <$> rawMem dest <*> compileExp destoffset+  <*> rawMem src <*> compileExp srcoffset+  <*> compileExp size  compileCode (Copy dest (Count destoffset) destspace src (Count srcoffset) srcspace (Count size)) = do   copy <- asks envCopy

@@ -9,12 +9,12 @@  import Control.Monad.Identity import Data.FileEmbed-import qualified Data.Map as M import qualified Data.Text as T+import qualified Data.Map as M import NeatInterpolation (text)  import Futhark.CodeGen.ImpCode.OpenCL-  (PrimType(..), SizeClass(..),+  (PrimType(..), SizeClass(..), sizeDefault,    FailureMsg(..), ErrorMsg(..), ErrorMsgPart(..), errorMsgArgTypes) import Futhark.CodeGen.OpenCL.Heuristics import Futhark.CodeGen.Backends.GenericPython.AST@@ -75,9 +75,8 @@   where f (size_name, size_class) =           (String $ pretty size_name,            Dict [(String "class", String $ pretty size_class),-                 (String "value", defValue size_class)])-        defValue (SizeBespoke _ x) = Integer $ toInteger x-        defValue _ = None+                 (String "value", maybe None (Integer . fromIntegral) $+                                  sizeDefault size_class)])  sizeHeuristicsToPython :: [SizeHeuristic] -> PyExp sizeHeuristicsToPython = List . map f

@@ -179,7 +179,7 @@         mkZExt from_t to_t = macro name [C.cexp|($ty:to_ct)(($ty:from_ct)x)|]           where name = "zext_"++pretty from_t++"_"++pretty to_t                 from_ct = uintTypeToCType from_t-                to_ct = uintTypeToCType to_t+                to_ct = intTypeToCType to_t          mkBToI to_t =           [C.cedecl|static inline $ty:to_ct@@ -416,6 +416,61 @@         x <<= 1;     }     return n;+   }+$esc:("#endif")++$esc:("#if defined(__OPENCL_VERSION__)")+   // OpenCL has ctz, but only from version 2.0, which we cannot assume we are using.+   static typename int32_t $id:(funName' "ctz8") (typename int8_t x) {+      int i = 0;+      for (; i < 8 && (x&1)==0; i++, x>>=1);+      return i;+   }+   static typename int32_t $id:(funName' "ctz16") (typename int16_t x) {+      int i = 0;+      for (; i < 16 && (x&1)==0; i++, x>>=1);+      return i;+   }+   static typename int32_t $id:(funName' "ctz32") (typename int32_t x) {+      int i = 0;+      for (; i < 32 && (x&1)==0; i++, x>>=1);+      return i;+   }+   static typename int32_t $id:(funName' "ctz64") (typename int64_t x) {+      int i = 0;+      for (; i < 64 && (x&1)==0; i++, x>>=1);+      return i;+   }+$esc:("#elif defined(__CUDA_ARCH__)")+   static typename int32_t $id:(funName' "ctz8") (typename int8_t x) {+     int y = __ffs(x);+     return y == 0 ? 8 : y-1;+   }+   static typename int32_t $id:(funName' "ctz16") (typename int16_t x) {+     int y = __ffs(x);+     return y == 0 ? 16 : y-1;+   }+   static typename int32_t $id:(funName' "ctz32") (typename int32_t x) {+     int y = __ffs(x);+     return y == 0 ? 32 : y-1;+   }+   static typename int32_t $id:(funName' "ctz64") (typename int64_t x) {+     int y = __ffsll(x);+     return y == 0 ? 64 : y-1;+   }+$esc:("#else")+// FIXME: assumes GCC or clang.+   static typename int32_t $id:(funName' "ctz8") (typename int8_t x) {+     return smin32(8, __builtin_ctz((typename uint32_t)x));+   }+   static typename int32_t $id:(funName' "ctz16") (typename int16_t x) {+     return smin32(16, __builtin_ctz((typename uint32_t)x));+   }+   static typename int32_t $id:(funName' "ctz32") (typename int32_t x) {+     return __builtin_ctz(x);+   }+   static typename int32_t $id:(funName' "ctz64") (typename int64_t x) {+     return __builtin_ctzl(x);    } $esc:("#endif")                 |]

@@ -334,7 +334,7 @@ -- per-element size. withElemType :: Count Elements Exp -> PrimType -> Count Bytes Exp withElemType (Count e) t =-  bytes $ ConvOpExp (SExt Int32 Int64) e * LeafExp (SizeOf t) (IntType Int64)+  bytes $ sExt Int64 e * LeafExp (SizeOf t) (IntType Int64)  -- | Turn a 'VName' into a 'Imp.ScalarVar'. var :: VName -> PrimType -> Exp

@@ -736,7 +736,7 @@   e' <- toExp e   s' <- toExp s   sFor "i" n' $ \i -> do-    let i' = ConvOpExp (SExt Int32 it) i+    let i' = sExt it i     x <- dPrimV "x" $ e' + i' * s'     copyDWIM (patElemName pe) [DimFix i] (Var x) [] @@ -1271,9 +1271,8 @@ -- straightforward contiguous format, as an 'Int64' expression. typeSize :: Type -> Count Bytes Imp.Exp typeSize t =-  Imp.bytes $ i64 (Imp.LeafExp (Imp.SizeOf $ elemType t) int32) *-  product (map (i64 . toExp' int32) (arrayDims t))-  where i64 = ConvOpExp (SExt Int32 Int64)+  Imp.bytes $ sExt Int64 (Imp.LeafExp (Imp.SizeOf $ elemType t) int32) *+  product (map (sExt Int64 . toExp' int32) (arrayDims t))  --- Building blocks for constructing code. 

@@ -106,14 +106,11 @@   -- issues.   let num_groups_maybe_zero = BinOpExp (SMin Int64)                               (toExp' int64 w64 `divUp`-                               i64 (toExp' int32 group_size)) $-                              i64 (Imp.vi32 max_num_groups)+                               sExt Int64 (toExp' int32 group_size)) $+                              sExt Int64 (Imp.vi32 max_num_groups)   -- We also don't want zero groups.   let num_groups = BinOpExp (SMax Int64) 1 num_groups_maybe_zero-  patElemName pe <-- i32 num_groups--  where i64 = ConvOpExp (SExt Int32 Int64)-        i32 = ConvOpExp (SExt Int64 Int32)+  patElemName pe <-- sExt Int32 num_groups  opCompiler dest (Inner (SegOp op)) =   segOpCompiler dest op@@ -123,8 +120,8 @@   pretty pat ++ "\nfor expression\n  " ++ pretty e  sizeClassWithEntryPoint :: Maybe Name -> Imp.SizeClass -> Imp.SizeClass-sizeClassWithEntryPoint fname (Imp.SizeThreshold path) =-  Imp.SizeThreshold $ map f path+sizeClassWithEntryPoint fname (Imp.SizeThreshold path def) =+  Imp.SizeThreshold (map f path) def   where f (name, x) = (keyWithEntryPoint fname name, x) sizeClassWithEntryPoint _ size_class = size_class @@ -161,7 +158,7 @@     sOp $ Imp.GetSizeMax local_memory_capacity SizeLocalMemory      let local_memory_capacity_64 =-          ConvOpExp (SExt Int32 Int64) $ Imp.vi32 local_memory_capacity+          sExt Int64 $ Imp.vi32 local_memory_capacity         fits size =           unCount size .<=. local_memory_capacity_64     return $ Just $ foldl' (.&&.) true (map fits alloc_sizes)

@@ -1104,7 +1104,7 @@   let group_size_var = Imp.var group_size int32       group_size_key = keyWithEntryPoint fname $ nameFromString $ pretty group_size   sOp $ Imp.GetSize group_size group_size_key Imp.SizeGroup-  num_groups <- dPrimV "num_groups" $ kernel_size `divUp` Imp.ConvOpExp (SExt Int32 Int32) group_size_var+  num_groups <- dPrimV "num_groups" $ kernel_size `divUp` group_size_var   return (Imp.var num_groups int32, Imp.var group_size int32)  simpleKernelConstants :: Imp.Exp -> String@@ -1223,9 +1223,9 @@             takeLast (length srcds) srcslice       copyElementWise pt destloc destslice' srcloc srcslice' -    _ ->-      groupCoverSpace (sliceDims destslice) $ \is -> do-      copyElementWise pt+    _ -> do+      groupCoverSpace (sliceDims destslice) $ \is ->+        copyElementWise pt         destloc (map DimFix $ fixSlice destslice is)         srcloc (map DimFix $ fixSlice srcslice is)       sOp $ Imp.Barrier Imp.FenceLocal@@ -1337,7 +1337,7 @@        emit $         Imp.Write destmem destidx (IntType et) destspace Imp.Nonvolatile $-        Imp.ConvOpExp (SExt Int32 et) gtid * s + x+        Imp.sExt et gtid * s + x  iotaName :: IntType -> String iotaName bt = "iota_" ++ pretty bt

@@ -59,9 +59,6 @@ import Futhark.Util (chunks, mapAccumLM, maxinum, splitFromEnd, takeLast) import Futhark.Construct (fullSliceNum) -i32Toi64 :: PrimExp v -> PrimExp v-i32Toi64 = ConvOpExp (SExt Int32 Int64)- data SubhistosInfo = SubhistosInfo { subhistosArray :: VName                                    , subhistosAlloc :: CallKernelGen ()                                    }@@ -76,7 +73,7 @@ histoSpaceUsage :: HistOp KernelsMem                 -> Imp.Count Imp.Bytes Imp.Exp histoSpaceUsage op =-  fmap (ConvOpExp (SExt Int64 Int32)) $ sum $+  fmap (sExt Int32) $ sum $   map (typeSize .        (`arrayOfRow` histWidth op) .        (`arrayOfShape` histShape op)) $@@ -270,11 +267,11 @@     slugElSize (SegHistSlug op _ _ do_op) =       case do_op of         AtomicLocking{} ->-          ConvOpExp (SExt Int64 Int32) $ unCount $+          sExt Int32 $ unCount $           sum $ map (typeSize . (`arrayOfShape` histShape op)) $           Prim int32 : lambdaReturnType (histOp op)         _ ->-          ConvOpExp (SExt Int64 Int32) $ unCount $ sum $+          sExt Int32 $ unCount $ sum $           map (typeSize . (`arrayOfShape` histShape op)) $           lambdaReturnType (histOp op) @@ -355,7 +352,7 @@ histKernelGlobalPass map_pes num_groups group_size space slugs kbody histograms hist_S chk_i = do    let (space_is, space_sizes) = unzip $ unSegSpace space-      space_sizes_64 = map (i32Toi64 . toExp' int32) space_sizes+      space_sizes_64 = map (sExt Int64 . toExp' int32) space_sizes       total_w_64 = product space_sizes_64    hist_H_chks <- forM (map (histWidth . slugOp) slugs) $ \w -> do@@ -374,15 +371,15 @@     -- Loop over flat offsets into the input and output.  The     -- calculation is done with 64-bit integers to avoid overflow,     -- but the final unflattened segment indexes are 32 bit.-    let gtid = i32Toi64 $ kernelGlobalThreadId constants-        num_threads = i32Toi64 $ kernelNumThreads constants+    let gtid = sExt Int64 $ kernelGlobalThreadId constants+        num_threads = sExt Int64 $ kernelNumThreads constants     kernelLoop gtid num_threads total_w_64 $ \offset -> do        -- Construct segment indices.       let setIndex v e = do dPrim_ v int32                             v <-- e       zipWithM_ setIndex space_is $-        map (ConvOpExp (SExt Int64 Int32)) $ unflattenIndex space_sizes_64 offset+        map (sExt Int32) $ unflattenIndex space_sizes_64 offset        -- We execute the bucket function once and update each histogram serially.       -- We apply the bucket function if j=offset+ltid is less than@@ -761,8 +758,6 @@    let r64 = ConvOpExp (SIToFP Int32 Float64)       t64 = ConvOpExp (FPToSI Float64 Int32)-      i32_to_i64 = ConvOpExp (SExt Int32 Int64)-      i64_to_i32 = ConvOpExp (SExt Int64 Int32)    -- M approximation.   hist_m' <- dPrimVE "hist_m_prime" $@@ -791,11 +786,11 @@     if segmented then do        hist_T_hist_min <- dPrimVE "hist_T_hist_min" $-                         i64_to_i32 $+                         sExt Int32 $                          Imp.BinOpExp (SMin Int64)-                         (i32_to_i64 hist_Nin * i32_to_i64 hist_Nout) (i32_to_i64 hist_T)+                         (sExt Int64 hist_Nin * sExt Int64 hist_Nout) (sExt Int64 hist_T)                          `divUp`-                         i32_to_i64 hist_Nout+                         sExt Int64 hist_Nout        -- Number of groups, rounded up.       let r = hist_T_hist_min `divUp` hist_B

@@ -78,8 +78,8 @@ cleanSizes :: M.Map Name SizeClass -> M.Map Name SizeClass cleanSizes m = M.map clean m   where known = M.keys m-        clean (SizeThreshold path) =-          SizeThreshold $ filter ((`elem` known) . fst) path+        clean (SizeThreshold path def) =+          SizeThreshold (filter ((`elem` known) . fst) path) def         clean s = s  pointerQuals ::  Monad m => String -> m [C.TypeQual]

@@ -434,7 +434,7 @@   Scalar (TypeVar _ u et targs) -> do     targs' <- mapM typeArgHtml targs     et' <- typeNameHtml et-    return $ prettyU u <> et' <> joinBy " " targs'+    return $ prettyU u <> et' <> mconcat (map (" "<>) targs')   Scalar (Arrow _ pname t1 t2) -> do     t1' <- typeHtml t1     t2' <- typeHtml t2@@ -614,8 +614,10 @@ typeArgExpHtml (TypeArgExpType d) = typeExpHtml d  typeParamHtml :: TypeParam -> Html-typeParamHtml (TypeParamDim name _) = brackets $ vnameHtml name-typeParamHtml (TypeParamType l name _) = fromString (pretty l) <> vnameHtml name+typeParamHtml (TypeParamDim name _) =+  brackets $ vnameHtml name+typeParamHtml (TypeParamType l name _) =+  "'" <> fromString (pretty l) <> vnameHtml name  typeAbbrevHtml :: Liftedness -> Html -> [TypeParam] -> Html typeAbbrevHtml l name params =

@@ -295,9 +295,11 @@   opMetrics (OtherOp op) = opMetrics op   opMetrics (SizeOp op) = opMetrics op -checkSegLevel :: Maybe SegLevel -> SegLevel -> TC.TypeM lore ()-checkSegLevel Nothing _ =-  return ()+checkSegLevel :: TC.Checkable lore =>+                 Maybe SegLevel -> SegLevel -> TC.TypeM lore ()+checkSegLevel Nothing lvl = do+  TC.require [Prim int32] $ unCount $ segNumGroups lvl+  TC.require [Prim int32] $ unCount $ segGroupSize lvl checkSegLevel (Just SegThread{}) _ =   TC.bad $ TC.TypeError "SegOps cannot occur when already at thread level." checkSegLevel (Just x) y

@@ -4,6 +4,7 @@ -- (run-time) constant. module Futhark.IR.Kernels.Sizes   ( SizeClass (..)+  , sizeDefault   , KernelPath   , Count(..)   , NumGroups, GroupSize, NumThreads@@ -25,7 +26,8 @@  -- | The class of some kind of configurable size.  Each class may -- impose constraints on the valid values.-data SizeClass = SizeThreshold KernelPath+data SizeClass = SizeThreshold KernelPath (Maybe Int32)+                 -- ^ A threshold with an optional default.                | SizeGroup                | SizeNumGroups                | SizeTile@@ -37,7 +39,7 @@                deriving (Eq, Ord, Show)  instance Pretty SizeClass where-  ppr (SizeThreshold path) = text $ "threshold (" ++ unwords (map pStep path) ++ ")"+  ppr (SizeThreshold path _) = text $ "threshold (" ++ unwords (map pStep path) ++ ")"     where pStep (v, True) = pretty v           pStep (v, False) = '!' : pretty v   ppr SizeGroup = text "group_size"@@ -45,6 +47,12 @@   ppr SizeTile = text "tile_size"   ppr SizeLocalMemory = text "local_memory"   ppr (SizeBespoke k _) = ppr k++-- | The default value for the size.  If 'Nothing', that means the backend gets to decide.+sizeDefault :: SizeClass -> Maybe Int32+sizeDefault (SizeThreshold _ x) = x+sizeDefault (SizeBespoke _ x) = Just x+sizeDefault _ = Nothing  -- | A wrapper supporting a phantom type for indicating what we are counting. newtype Count u e = Count { unCount :: e }

@@ -155,8 +155,7 @@             not $ freeIn ixfun `namesIntersect` namesFromList (patternNames pat),             fse /= tse =               let mem_size =-                    ConvOpExp (SExt Int32 Int64) $-                    product $ primByteSize pt : IxFun.base ixfun+                    sExt Int64 $ product $ primByteSize pt : IxFun.base ixfun               in (pat_elem, mem_size, mem, space) : fixable           | otherwise =               fixable

@@ -953,6 +953,11 @@   , i32 "clz32" $ IntValue . Int32Value . fromIntegral . countLeadingZeros   , i64 "clz64" $ IntValue . Int32Value . fromIntegral . countLeadingZeros +  , i8 "ctz8" $ IntValue . Int32Value . fromIntegral . countTrailingZeros+  , i16 "ctz16" $ IntValue . Int32Value . fromIntegral . countTrailingZeros+  , i32 "ctz32" $ IntValue . Int32Value . fromIntegral . countTrailingZeros+  , i64 "ctz64" $ IntValue . Int32Value . fromIntegral . countTrailingZeros+   , i8 "popc8" $ IntValue . Int32Value . fromIntegral . popCount   , i16 "popc16" $ IntValue . Int32Value . fromIntegral . popCount   , i32 "popc32" $ IntValue . Int32Value . fromIntegral . popCount

@@ -733,7 +733,7 @@  internaliseExp desc (E.Assert e1 e2 (Info check) loc) = do   e1' <- internaliseExp1 "assert_cond" e1-  c <- assert "assert_c" e1' (errorMsg [ErrorString check]) loc+  c <- assert "assert_c" e1' (errorMsg [ErrorString $ "Assertion is false: " <> check]) loc   -- Make sure there are some bindings to certify.   certifying c $ mapM rebind =<< internaliseExp desc e2   where rebind v = do

@@ -50,6 +50,11 @@ import Futhark.Pass  -- | Perform CSE on every function in a program.+--+-- If the boolean argument is false, the pass will not perform CSE on+-- expressions producing arrays. This should be disabled when the lore has+-- memory information, since at that point arrays have identity beyond their+-- value. performCSE :: (ASTLore lore, CanBeAliased (Op lore),                CSEInOp (OpWithAliases (Op lore))) =>               Bool -> Pass lore lore@@ -65,6 +70,11 @@         onFun _ = pure . cseInFunDef cse_arrays  -- | Perform CSE on a single function.+--+-- If the boolean argument is false, the pass will not perform CSE on+-- expressions producing arrays. This should be disabled when the lore has+-- memory information, since at that point arrays have identity beyond their+-- value. performCSEOnFunDef :: (ASTLore lore, CanBeAliased (Op lore),                        CSEInOp (OpWithAliases (Op lore))) =>                       Bool -> FunDef lore -> FunDef lore@@ -72,6 +82,11 @@   removeFunDefAliases . cseInFunDef cse_arrays . analyseFun  -- | Perform CSE on some statements.+--+-- If the boolean argument is false, the pass will not perform CSE on+-- expressions producing arrays. This should be disabled when the lore has+-- memory information, since at that point arrays have identity beyond their+-- value. performCSEOnStms :: (ASTLore lore, CanBeAliased (Op lore),                      CSEInOp (OpWithAliases (Op lore))) =>                     Bool -> Stms lore -> Stms lore

@@ -58,7 +58,7 @@ asInt32PrimExp :: PrimExp v -> PrimExp v asInt32PrimExp pe   | IntType it <- primExpType pe, it /= Int32 =-      ConvOpExp (SExt it Int32) pe+      sExt Int32 pe   | otherwise =       pe @@ -646,7 +646,7 @@         Just (Prim (IntType from_it)) <- seType ii ->           Just $           fmap (SubExpResult cs) $ toSubExp "index_iota" $-          ConvOpExp (SExt from_it to_it) (primExpFromSubExp (IntType from_it) ii)+          sExt to_it (primExpFromSubExp (IntType from_it) ii)           * primExpFromSubExp (IntType to_it) s           + primExpFromSubExp (IntType to_it) x       | [DimSlice i_offset i_n i_stride] <- inds ->

@@ -376,7 +376,7 @@         -- which is then offset by a thread-specific amount.         newBase size_per_thread (old_shape, pt) =           let pt_size = fromInt32 $ primByteSize pt-              elems_per_thread = ConvOpExp (SExt Int64 Int32)+              elems_per_thread = sExt Int32                                  (primExpFromSubExp int64 size_per_thread)                                  `quot` pt_size               root_ixfun = IxFun.iota [elems_per_thread, num_threads']

@@ -48,7 +48,7 @@ import qualified Data.Map.Strict as M import qualified Data.Set as S import Data.Maybe-import Data.List (zip4, partition, sort)+import Data.List (foldl', zip4, partition, sort)  import qualified Futhark.Analysis.UsageTable as UT import Futhark.Optimise.Simplify.Lore (mkWiseBody)@@ -231,18 +231,16 @@  arraySizeInBytesExp :: Type -> PrimExp VName arraySizeInBytesExp t =-  product-    [ toInt64 $ product $ map (primExpFromSubExp int32) (arrayDims t)-    , ValueExp $ IntValue $ Int64Value $ primByteSize $ elemType t ]-  where toInt64 = ConvOpExp $ SExt Int32 Int64+  foldl' (*)+  (ValueExp $ IntValue $ Int64Value $ primByteSize $ elemType t) $+  map (sExt Int64 .primExpFromSubExp int32) (arrayDims t)  arraySizeInBytesExpM :: Allocator lore m => Type -> m (PrimExp VName) arraySizeInBytesExpM t = do   dims <- mapM dimAllocationSize (arrayDims t)-  let dim_prod_i32 = product $ map (toInt64 . primExpFromSubExp int32) dims+  let dim_prod_i32 = product $ map (sExt Int64 . primExpFromSubExp int32) dims   let elm_size_i64 = ValueExp $ IntValue $ Int64Value $ primByteSize $ elemType t   return $ product [ dim_prod_i32, elm_size_i64 ]-  where toInt64 = ConvOpExp $ SExt Int32 Int64  arraySizeInBytes :: Allocator lore m => Type -> m SubExp arraySizeInBytes = computeSize "bytes" <=< arraySizeInBytesExpM@@ -377,7 +375,7 @@ summaryForBindage t (Hint ixfun space) = do   let bt = elemType t   bytes <- computeSize "bytes" $-           product [ConvOpExp (SExt Int32 Int64) (product (IxFun.base ixfun)),+           product [product $ map (sExt Int64) $ IxFun.base ixfun,                     fromIntegral (primByteSize (elemType t)::Int64)]   m <- allocateMemory "mem" bytes space   return $ MemArray bt (arrayShape t) NoUniqueness $ ArrayIn m ixfun

@@ -438,7 +438,7 @@     then paralleliseOuter     else do     ((outer_suff, outer_suff_key), suff_stms) <--      sufficientParallelism "suff_outer_redomap" [w] path+      sufficientParallelism "suff_outer_redomap" [w] path Nothing      outer_stms <- outerParallelBody     inner_stms <- innerParallelBody ((outer_suff_key, False):path)@@ -460,7 +460,7 @@       paralleliseOuter path   | otherwise = do       ((outer_suff, outer_suff_key), suff_stms) <--        sufficientParallelism "suff_outer_stream" [w] path+        sufficientParallelism "suff_outer_stream" [w] path Nothing        outer_stms <- outerParallelBody ((outer_suff_key, True) : path)       inner_stms <- innerParallelBody ((outer_suff_key, False) : path)@@ -560,9 +560,10 @@ transformStm _ bnd =   runBinder_ $ FOT.transformStmRecursively bnd -sufficientParallelism :: String -> [SubExp] -> KernelPath+sufficientParallelism :: String -> [SubExp] -> KernelPath -> Maybe Int32                       -> DistribM ((SubExp, Name), Out.Stms Out.Kernels)-sufficientParallelism desc ws path = cmpSizeLe desc (Out.SizeThreshold path) ws+sufficientParallelism desc ws path def =+  cmpSizeLe desc (Out.SizeThreshold path def) ws  -- | Intra-group parallelism is worthwhile if the lambda contains more -- than one instance of non-map nested parallelism, or any nested@@ -581,6 +582,8 @@               mapLike w lam'           | DoLoop _ _ _ body <- stmExp stm =               bodyInterest body * 10+          | If _ tbody fbody _ <- stmExp stm =+              bodyInterest tbody + bodyInterest fbody -- Ad-hoc.           | Op (Screma w (ScremaForm _ _ lam') _) <- stmExp stm =               zeroIfTooSmall w + bodyInterest (lambdaBody lam')           | Op (Stream _ (Sequential _) lam' _) <- stmExp stm =@@ -683,6 +686,12 @@   AttrComp "incremental_flattening" ["no_intra"] `inAttrs` attrs ||   AttrComp "incremental_flattening" ["only_inner"] `inAttrs` attrs +-- The minimum amount of inner parallelism we require (by default) in+-- intra-group versions.  Less than this is usually pointless on a GPU+-- (but we allow tuning to change it).+intraMinInnerPar :: Int32+intraMinInnerPar = 32 -- One NVIDIA warp+ onMap' :: KernelNest -> KernelPath        -> (KernelPath -> DistribM (Out.Stms Out.Kernels))        -> (KernelPath -> DistribM (Out.Stms Out.Kernels))@@ -697,7 +706,7 @@    types <- askScope   ((outer_suff, outer_suff_key), outer_suff_stms) <--    sufficientParallelism "suff_outer_par" nest_ws path+    sufficientParallelism "suff_outer_par" nest_ws path Nothing    intra <- if onlyExploitIntra (stmAuxAttrs aux) ||               (worthIntraGroup lam && mayExploitIntra attrs) then@@ -723,8 +732,8 @@       ((intra_ok, intra_suff_key), intra_suff_stms) <- do          ((intra_suff, suff_key), check_suff_stms) <--          sufficientParallelism "suff_intra_par" (nest_ws ++ [intra_avail_par]) $-          (outer_suff_key, False) : path+          sufficientParallelism "suff_intra_par" [intra_avail_par]+          ((outer_suff_key, False) : path) (Just intraMinInnerPar)          runBinder $ do 

@@ -72,7 +72,8 @@  import Futhark.Analysis.Metrics import Futhark.IR.Primitive-       (IntType(..), intValue, FloatType(..), intByteSize, floatByteSize)+       (IntType(..), intValue, intByteSize,+        FloatType(..), floatValue, floatByteSize) import Futhark.Test.Values import Futhark.Util (directoryContents, pmapIO) import Futhark.Util.Pretty (pretty, prettyText)@@ -292,6 +293,7 @@ parseGenValue = choice [ GenValue <$> many dim <*> parsePrimType                        , lexeme $ GenPrim <$> choice [i8, i16, i32, i64,                                                       u8, u16, u32, u64,+                                                      f32, f64,                                                       int SignedValue Int32 ""]                        ]   where digits = some (satisfy isDigit)@@ -301,6 +303,9 @@         readint :: String -> Integer         readint = read -- To avoid warnings. +        readfloat :: String -> Double+        readfloat = read -- To avoid warnings.+         int f t s = try $ lexeme $ f . intValue t  . readint <$> digits <*                     string s <*                     notFollowedBy (satisfy isAlphaNum)@@ -312,6 +317,17 @@         u16 = int UnsignedValue Int16 "u16"         u32 = int UnsignedValue Int32 "u32"         u64 = int UnsignedValue Int64 "u64"++        optSuffix s suff = do+          s' <- s+          ((s'<>) <$> suff) <|> pure s'++        float f t s = try $ lexeme $ f . floatValue t  . readfloat <$>+                      (digits `optSuffix` (char '.' *> (("."<>) <$> digits))) <*+                      string s <*+                      notFollowedBy (satisfy isAlphaNum)+        f32 = float FloatValue Float32 "f32"+        f64 = float FloatValue Float64 "f64"  parsePrimType :: Parser PrimType parsePrimType =

@@ -44,7 +44,7 @@ @romlit = 0[rR][IVXLCDM][IVXLCDM_]* @intlit = @hexlit|@binlit|@declit|@romlit @reallit = (([0-9][0-9_]*("."[0-9][0-9_]*)?))([eE][\+\-]?[0-9]+)?-@hexreallit = 0[xX][0-9a-fA-F][0-9a-fA-F_]*"."[0-9a-fA-F][0-9a-fA-F_]*([pP][\+\-]?[0-9]+)+@hexreallit = 0[xX][0-9a-fA-F][0-9a-fA-F_]*"."[0-9a-fA-F][0-9a-fA-F_]*([pP][\+\-]?[0-9_]+)  @field = [a-zA-Z0-9] [a-zA-Z0-9_]* 

@@ -189,7 +189,7 @@   if length ps /= length targs   then typeError tloc mempty $        "Type constructor" <+> pquote (ppr tname) <+> "requires" <+> ppr (length ps) <+>-       "arguments, but provided" <+> ppr (length targs) <+> "."+       "arguments, but provided" <+> ppr (length targs) <> "."   else do     (targs', substs) <- unzip <$> zipWithM checkArgApply ps targs     return (foldl (\x y -> TEApply x y tloc) (TEVar tname' tname_loc) targs',