diff --git a/futhark.cabal b/futhark.cabal --- a/futhark.cabal +++ b/futhark.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: futhark -version: 0.17.1 +version: 0.17.2 synopsis: An optimising compiler for a functional, array-oriented language. description: Futhark is a small programming language designed to be compiled to diff --git a/prelude/array.fut b/prelude/array.fut --- a/prelude/array.fut +++ b/prelude/array.fut @@ -24,13 +24,13 @@ let init [n] 't (x: [n]t) = x[0:n-1] -- | Take some number of elements from the head of the array. -let take [n] 't (i: i64) (x: [n]t): [i]t = x[0:i] +let take [n] 't (i: i32) (x: [n]t): [i]t = x[0:i] -- | Remove some number of elements from the head of the array. -let drop [n] 't (i: i64) (x: [n]t) = x[i:] +let drop [n] 't (i: i32) (x: [n]t) = x[i:] -- | Split an array at a given position. -let split [n] 't (i: i64) (xs: [n]t): ([i]t, []t) = +let split [n] 't (i: i32) (xs: [n]t): ([i]t, []t) = (xs[:i] :> [i]t, xs[i:]) -- | Return the elements of the array in reverse order. @@ -46,28 +46,28 @@ -- | Concatenation where the result has a predetermined size. If the -- provided size is wrong, the function will fail with a run-time -- error. -let concat_to [n] [m] 't (k: i64) (xs: [n]t) (ys: [m]t): *[k]t = xs ++ ys :> [k]t +let concat_to [n] [m] 't (k: i32) (xs: [n]t) (ys: [m]t): *[k]t = xs ++ ys :> [k]t -- | Rotate an array some number of elements to the left. A negative -- rotation amount is also supported. -- -- For example, if `b==rotate r a`, then `b[x+r] = a[x]`. -let rotate [n] 't (r: i64) (xs: [n]t): [n]t = intrinsics.rotate (r, xs) :> [n]t +let rotate [n] 't (r: i32) (xs: [n]t): [n]t = intrinsics.rotate (r, xs) :> [n]t -- | Construct an array of consecutive integers of the given length, -- starting at 0. -let iota (n: i64): *[n]i64 = +let iota (n: i32): *[n]i32 = 0..1.. x) (iota n) -- | Copy a value. The result will not alias anything. let copy 't (a: t): *t = @@ -79,7 +79,7 @@ -- | Like `flatten`@term, but where the final size is known. Fails at -- runtime if the provided size is wrong. -let flatten_to [n][m] 't (l: i64) (xs: [n][m]t): [l]t = +let flatten_to [n][m] 't (l: i32) (xs: [n][m]t): [l]t = flatten xs :> [l]t -- | Combines the outer three dimensions of an array. @@ -91,15 +91,15 @@ flatten (flatten_3d xs) -- | Splits the outer dimension of an array in two. -let unflatten [p] 't (n: i64) (m: i64) (xs: [p]t): [n][m]t = +let unflatten [p] 't (n: i32) (m: i32) (xs: [p]t): [n][m]t = intrinsics.unflatten (n, m, xs) :> [n][m]t -- | Splits the outer dimension of an array in three. -let unflatten_3d [p] 't (n: i64) (m: i64) (l: i64) (xs: [p]t): [n][m][l]t = +let unflatten_3d [p] 't (n: i32) (m: i32) (l: i32) (xs: [p]t): [n][m][l]t = unflatten n m (unflatten (n*m) l xs) -- | Splits the outer dimension of an array in four. -let unflatten_4d [p] 't (n: i64) (m: i64) (l: i64) (k: i64) (xs: [p]t): [n][m][l][k]t = +let unflatten_4d [p] 't (n: i32) (m: i32) (l: i32) (k: i32) (xs: [p]t): [n][m][l][k]t = unflatten n m (unflatten_3d (n*m) l k xs) let transpose [n] [m] 't (a: [n][m]t): [m][n]t = @@ -122,13 +122,13 @@ foldl (flip f) acc (reverse bs) -- | Create a value for each point in a one-dimensional index space. -let tabulate 'a (n: i64) (f: i64 -> a): *[n]a = +let tabulate 'a (n: i32) (f: i32 -> a): *[n]a = map1 f (iota n) -- | Create a value for each point in a two-dimensional index space. -let tabulate_2d 'a (n: i64) (m: i64) (f: i64 -> i64 -> a): *[n][m]a = +let tabulate_2d 'a (n: i32) (m: i32) (f: i32 -> i32 -> a): *[n][m]a = map1 (f >-> tabulate m) (iota n) -- | Create a value for each point in a three-dimensional index space. -let tabulate_3d 'a (n: i64) (m: i64) (o: i64) (f: i64 -> i64 -> i64 -> a): *[n][m][o]a = +let tabulate_3d 'a (n: i32) (m: i32) (o: i32) (f: i32 -> i32 -> i32 -> a): *[n][m][o]a = map1 (f >-> tabulate_2d m o) (iota n) diff --git a/prelude/math.fut b/prelude/math.fut --- a/prelude/math.fut +++ b/prelude/math.fut @@ -2,6 +2,8 @@ import "soacs" +local let const 'a 'b (x: a) (_: b): a = x + -- | Describes types of values that can be created from the primitive -- numeric types (and bool). module type from_prim = { @@ -120,7 +122,8 @@ module type real = { include numeric - val from_fraction: i64 -> i64 -> t + val from_fraction: i32 -> i32 -> t + val to_i32: t -> i32 val to_i64: t -> i64 val to_f64: t -> f64 @@ -849,7 +852,8 @@ let bool (x: bool) = if x then 1f64 else 0f64 - let from_fraction (x: i64) (y: i64) = i64 x / i64 y + let from_fraction (x: i32) (y: i32) = i32 x / i32 y + let to_i32 (x: f64) = intrinsics.fptosi_f64_i32 x let to_i64 (x: f64) = intrinsics.fptosi_f64_i64 x let to_f64 (x: f64) = x @@ -956,7 +960,8 @@ let bool (x: bool) = if x then 1f32 else 0f32 - let from_fraction (x: i64) (y: i64) = i64 x / i64 y + let from_fraction (x: i32) (y: i32) = i32 x / i32 y + let to_i32 (x: f32) = intrinsics.fptosi_f32_i32 x let to_i64 (x: f32) = intrinsics.fptosi_f32_i64 x let to_f64 (x: f32) = intrinsics.fpconv_f32_f64 x diff --git a/prelude/soacs.fut b/prelude/soacs.fut --- a/prelude/soacs.fut +++ b/prelude/soacs.fut @@ -118,7 +118,7 @@ -- -- In practice, the *O(n)* behaviour only occurs if *m* is also very -- large. -let reduce_by_index 'a [m] [n] (dest : *[m]a) (f : a -> a -> a) (ne : a) (is : [n]i64) (as : [n]a) : *[m]a = +let reduce_by_index 'a [m] [n] (dest : *[m]a) (f : a -> a -> a) (ne : a) (is : [n]i32) (as : [n]a) : *[m]a = intrinsics.hist (1, dest, f, ne, is, as) :> *[m]a -- | Inclusive prefix scan. Has the same caveats with respect to @@ -163,7 +163,7 @@ -- | `reduce_stream op f as` splits `as` into chunks, applies `f` to each -- of these in parallel, and uses `op` (which must be associative) to --- combine the per-chunk results into a final result. The `i64` +-- combine the per-chunk results into a final result. The `i32` -- passed to `f` is the size of the chunk. This SOAC is useful when -- `f` can be given a particularly work-efficient sequential -- implementation. Operationally, we can imagine that `as` is divided @@ -176,7 +176,7 @@ -- **Work:** *O(n)* -- -- **Span:** *O(log(n))* -let reduce_stream [n] 'a 'b (op: b -> b -> b) (f: (k: i64) -> [k]a -> b) (as: [n]a): b = +let reduce_stream [n] 'a 'b (op: b -> b -> b) (f: (k: i32) -> [k]a -> b) (as: [n]a): b = intrinsics.reduce_stream (op, f, as) -- | As `reduce_stream`@term, but the chunks do not necessarily @@ -186,7 +186,7 @@ -- **Work:** *O(n)* -- -- **Span:** *O(log(n))* -let reduce_stream_per [n] 'a 'b (op: b -> b -> b) (f: (k: i64) -> [k]a -> b) (as: [n]a): b = +let reduce_stream_per [n] 'a 'b (op: b -> b -> b) (f: (k: i32) -> [k]a -> b) (as: [n]a): b = intrinsics.reduce_stream_per (op, f, as) -- | Similar to `reduce_stream`@term, except that each chunk must produce @@ -196,7 +196,7 @@ -- **Work:** *O(n)* -- -- **Span:** *O(1)* -let map_stream [n] 'a 'b (f: (k: i64) -> [k]a -> [k]b) (as: [n]a): *[n]b = +let map_stream [n] 'a 'b (f: (k: i32) -> [k]a -> [k]b) (as: [n]a): *[n]b = intrinsics.map_stream (f, as) :> *[n]b -- | Similar to `map_stream`@term, but the chunks do not necessarily @@ -206,7 +206,7 @@ -- **Work:** *O(n)* -- -- **Span:** *O(1)* -let map_stream_per [n] 'a 'b (f: (k: i64) -> [k]a -> [k]b) (as: [n]a): *[n]b = +let map_stream_per [n] 'a 'b (f: (k: i32) -> [k]a -> [k]b) (as: [n]a): *[n]b = intrinsics.map_stream_per (f, as) :> *[n]b -- | Return `true` if the given function returns `true` for all @@ -252,5 +252,5 @@ -- **Work:** *O(n)* -- -- **Span:** *O(1)* -let scatter 't [m] [n] (dest: *[m]t) (is: [n]i64) (vs: [n]t): *[m]t = +let scatter 't [m] [n] (dest: *[m]t) (is: [n]i32) (vs: [n]t): *[m]t = intrinsics.scatter (dest, is, vs) :> *[m]t diff --git a/rts/python/opencl.py b/rts/python/opencl.py --- a/rts/python/opencl.py +++ b/rts/python/opencl.py @@ -122,7 +122,7 @@ self.global_failure = self.pool.allocate(np.int32().itemsize) cl.enqueue_fill_buffer(self.queue, self.global_failure, np.int32(-1), 0, np.int32().itemsize) - self.global_failure_args = self.pool.allocate(np.int64().itemsize * + self.global_failure_args = self.pool.allocate(np.int32().itemsize * (self.global_failure_args_max+1)) self.failure_is_an_option = np.int32(0) @@ -225,7 +225,7 @@ cl.enqueue_fill_buffer(self.queue, self.global_failure, np.int32(-1), 0, np.int32().itemsize) # Read failure args. - failure_args = np.empty(self.global_failure_args_max+1, dtype=np.int64) + failure_args = np.empty(self.global_failure_args_max+1, dtype=np.int32) cl.enqueue_copy(self.queue, failure_args, self.global_failure_args, is_blocking=True) raise Exception(self.failure_msgs[failure[0]].format(*failure_args)) diff --git a/src/Futhark/Analysis/HORep/SOAC.hs b/src/Futhark/Analysis/HORep/SOAC.hs --- a/src/Futhark/Analysis/HORep/SOAC.hs +++ b/src/Futhark/Analysis/HORep/SOAC.hs @@ -526,7 +526,7 @@ SOAC lore -> m (SOAC lore, [Ident]) soacToStream soac = do - chunk_param <- newParam "chunk" $ Prim int64 + chunk_param <- newParam "chunk" $ Prim int32 let chvar = Futhark.Var $ paramName chunk_param (lam, inps) = (lambda soac, inputs soac) w = width soac @@ -579,7 +579,7 @@ lastel_tmp_ids <- mapM (newIdent "lstel_tmp") accrtps empty_arr <- newIdent "empty_arr" $ Prim Bool inpacc_ids <- mapM (newParam "inpacc") accrtps - outszm1id <- newIdent "szm1" $ Prim int64 + outszm1id <- newIdent "szm1" $ Prim int32 -- 1. let (scan0_ids,map_resids) = scanomap(scan_lam,nes,map_lam,a_ch) let insbnd = mkLet [] (scan0_ids ++ map_resids) $ @@ -591,17 +591,17 @@ mkLet [] [outszm1id] $ BasicOp $ BinOp - (Sub Int64 OverflowUndef) + (Sub Int32 OverflowUndef) (Futhark.Var $ paramName chunk_param) - (constant (1 :: Int64)) + (constant (1 :: Int32)) -- 3. let lasteel_ids = ... empty_arr_bnd = mkLet [] [empty_arr] $ BasicOp $ CmpOp - (CmpSlt Int64) + (CmpSlt Int32) (Futhark.Var $ identName outszm1id) - (constant (0 :: Int64)) + (constant (0 :: Int32)) leltmpbnds = zipWith ( \lid arrid -> diff --git a/src/Futhark/Analysis/PrimExp/Convert.hs b/src/Futhark/Analysis/PrimExp/Convert.hs --- a/src/Futhark/Analysis/PrimExp/Convert.hs +++ b/src/Futhark/Analysis/PrimExp/Convert.hs @@ -7,8 +7,6 @@ primExpFromSubExp, pe32, le32, - pe64, - le64, primExpFromSubExpM, replaceInPrimExp, replaceInPrimExpM, @@ -94,14 +92,6 @@ le32 :: a -> TPrimExp Int32 a le32 = isInt32 . flip LeafExp int32 --- | Shorthand for constructing a 'TPrimExp' of type 'Int64'. -pe64 :: SubExp -> TPrimExp Int64 VName -pe64 = isInt64 . primExpFromSubExp int64 - --- | Shorthand for constructing a 'TPrimExp' of type 'Int64', from a leaf. -le64 :: a -> TPrimExp Int64 a -le64 = isInt64 . flip LeafExp int64 - -- | Applying a monadic transformation to the leaves in a 'PrimExp'. replaceInPrimExpM :: Monad m => @@ -143,9 +133,9 @@ fromMaybe (LeafExp v t) $ M.lookup v tab -- | Convert a 'SubExp' slice to a 'PrimExp' slice. -primExpSlice :: Slice SubExp -> Slice (TPrimExp Int64 VName) -primExpSlice = map $ fmap pe64 +primExpSlice :: Slice SubExp -> Slice (TPrimExp Int32 VName) +primExpSlice = map $ fmap $ isInt32 . primExpFromSubExp int32 -- | Convert a 'PrimExp' slice to a 'SubExp' slice. -subExpSlice :: MonadBinder m => Slice (TPrimExp Int64 VName) -> m (Slice SubExp) +subExpSlice :: MonadBinder m => Slice (TPrimExp Int32 VName) -> m (Slice SubExp) subExpSlice = mapM $ traverse $ toSubExp "slice" diff --git a/src/Futhark/Analysis/SymbolTable.hs b/src/Futhark/Analysis/SymbolTable.hs --- a/src/Futhark/Analysis/SymbolTable.hs +++ b/src/Futhark/Analysis/SymbolTable.hs @@ -111,7 +111,7 @@ Indexed Certificates (PrimExp VName) | -- | The indexing corresponds to another (perhaps more -- advantageous) array. - IndexedArray Certificates VName [TPrimExp Int64 VName] + IndexedArray Certificates VName [TPrimExp Int32 VName] indexedAddCerts :: Certificates -> Indexed -> Indexed indexedAddCerts cs1 (Indexed cs2 v) = Indexed (cs1 <> cs2) v @@ -122,7 +122,7 @@ freeIn' (IndexedArray cs arr v) = freeIn' cs <> freeIn' arr <> freeIn' v -- | Indexing a delayed array if possible. -type IndexArray = [TPrimExp Int64 VName] -> Maybe Indexed +type IndexArray = [TPrimExp Int32 VName] -> Maybe Indexed data Entry lore = Entry { -- | True if consumed. @@ -265,7 +265,7 @@ index' :: VName -> - [TPrimExp Int64 VName] -> + [TPrimExp Int32 VName] -> SymbolTable lore -> Maybe Indexed index' name is vtable = do @@ -288,7 +288,7 @@ SymbolTable lore -> Int -> op -> - [TPrimExp Int64 VName] -> + [TPrimExp Int32 VName] -> Maybe Indexed indexOp _ _ _ _ = Nothing @@ -322,18 +322,18 @@ | Just oldshape <- arrayDims <$> lookupType v table = let is' = reshapeIndex - (map pe64 oldshape) - (map pe64 $ newDims newshape) + (map pe32 oldshape) + (map pe32 $ newDims newshape) is in index' v is' table indexExp table (BasicOp (Index v slice)) _ is = index' v (adjust slice is) table where adjust (DimFix j : js') is' = - pe64 j : adjust js' is' + pe32 j : adjust js' is' adjust (DimSlice j _ s : js') (i : is') = - let i_t_s = i * pe64 s - j_p_i_t_s = pe64 j + i_t_s + let i_t_s = i * pe32 s + j_p_i_t_s = pe32 j + i_t_s in j_p_i_t_s : adjust js' is' adjust _ _ = [] indexExp _ _ _ _ = Nothing diff --git a/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs b/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs --- a/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs +++ b/src/Futhark/CodeGen/Backends/CCUDA/Boilerplate.hs @@ -392,7 +392,7 @@ CUDA_SUCCEED(cuMemAlloc(&ctx->global_failure, sizeof(no_error))); CUDA_SUCCEED(cuMemcpyHtoD(ctx->global_failure, &no_error, sizeof(no_error))); // The +1 is to avoid zero-byte allocations. - CUDA_SUCCEED(cuMemAlloc(&ctx->global_failure_args, sizeof(int64_t)*($int:max_failure_args+1))); + CUDA_SUCCEED(cuMemAlloc(&ctx->global_failure_args, sizeof(int32_t)*($int:max_failure_args+1))); $stms:init_kernel_fields @@ -442,7 +442,7 @@ &no_failure, sizeof(int32_t))); - typename int64_t args[$int:max_failure_args+1]; + typename int32_t args[$int:max_failure_args+1]; CUDA_SUCCEED( cuMemcpyDtoH(&args, ctx->global_failure_args, diff --git a/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs b/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs --- a/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs +++ b/src/Futhark/CodeGen/Backends/COpenCL/Boilerplate.hs @@ -41,8 +41,7 @@ escapeChar c = [c] in concatMap escapeChar onPart (ErrorString s) = printfEscape s - onPart ErrorInt32 {} = "%lld" - onPart ErrorInt64 {} = "%lld" + onPart ErrorInt32 {} = "%d" onFailure i (FailureMsg emsg@(ErrorMsg parts) backtrace) = let msg = concatMap onPart parts ++ "\n" ++ printfEscape backtrace msgargs = [[C.cexp|args[$int:j]|] | j <- [0 .. errorMsgNumArgs emsg -1]] @@ -376,7 +375,7 @@ ctx->global_failure_args = clCreateBuffer(ctx->opencl.ctx, CL_MEM_READ_WRITE, - sizeof(int64_t)*($int:max_failure_args+1), NULL, &error); + sizeof(cl_int)*($int:max_failure_args+1), NULL, &error); OPENCL_SUCCEED_OR_RETURN(error); // Load all the kernels. @@ -473,7 +472,7 @@ 0, sizeof(cl_int), &no_failure, 0, NULL, NULL)); - typename int64_t args[$int:max_failure_args+1]; + typename cl_int args[$int:max_failure_args+1]; OPENCL_SUCCEED_OR_RETURN( clEnqueueReadBuffer(ctx->opencl.queue, ctx->global_failure_args, diff --git a/src/Futhark/CodeGen/Backends/GenericC.hs b/src/Futhark/CodeGen/Backends/GenericC.hs --- a/src/Futhark/CodeGen/Backends/GenericC.hs +++ b/src/Futhark/CodeGen/Backends/GenericC.hs @@ -209,7 +209,6 @@ free_all_mem <- collect $ mapM_ (uncurry unRefMem) =<< gets compDeclaredMem let onPart (ErrorString s) = return ("%s", [C.cexp|$string:s|]) onPart (ErrorInt32 x) = ("%d",) <$> compileExp x - onPart (ErrorInt64 x) = ("%lld",) <$> compileExp x (formatstrs, formatargs) <- unzip <$> mapM onPart parts let formatstr = "Error: " ++ concat formatstrs ++ "\n\nBacktrace:\n%s" items diff --git a/src/Futhark/CodeGen/Backends/GenericPython.hs b/src/Futhark/CodeGen/Backends/GenericPython.hs --- a/src/Futhark/CodeGen/Backends/GenericPython.hs +++ b/src/Futhark/CodeGen/Backends/GenericPython.hs @@ -1132,7 +1132,6 @@ e' <- compileExp e let onPart (Imp.ErrorString s) = return ("%s", String s) onPart (Imp.ErrorInt32 x) = ("%d",) <$> compileExp x - onPart (Imp.ErrorInt64 x) = ("%d",) <$> compileExp x (formatstrs, formatargs) <- unzip <$> mapM onPart parts stm $ Assert diff --git a/src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs b/src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs --- a/src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs +++ b/src/Futhark/CodeGen/Backends/PyOpenCL/Boilerplate.hs @@ -82,7 +82,6 @@ onPart (ErrorString s) = formatEscape s onPart ErrorInt32 {} = "{}" - onPart ErrorInt64 {} = "{}" sizeClassesToPython :: M.Map Name SizeClass -> PyExp sizeClassesToPython = Dict . map f . M.toList diff --git a/src/Futhark/CodeGen/ImpCode.hs b/src/Futhark/CodeGen/ImpCode.hs --- a/src/Futhark/CodeGen/ImpCode.hs +++ b/src/Futhark/CodeGen/ImpCode.hs @@ -364,7 +364,7 @@ -- | Convert a count of elements into a count of bytes, given the -- per-element size. -withElemType :: Count Elements (TExp Int64) -> PrimType -> Count Bytes (TExp Int64) +withElemType :: Count Elements (TExp Int32) -> PrimType -> Count Bytes (TExp Int64) withElemType (Count e) t = bytes $ sExt64 e * isInt64 (LeafExp (SizeOf t) (IntType Int64)) diff --git a/src/Futhark/CodeGen/ImpCode/Kernels.hs b/src/Futhark/CodeGen/ImpCode/Kernels.hs --- a/src/Futhark/CodeGen/ImpCode/Kernels.hs +++ b/src/Futhark/CodeGen/ImpCode/Kernels.hs @@ -165,17 +165,17 @@ -- This old value is stored in the first 'VName'. The second 'VName' -- is the memory block to update. The 'Exp' is the new value. data AtomicOp - = AtomicAdd IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicFAdd FloatType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicSMax IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicSMin IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicUMax IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicUMin IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicAnd IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicOr IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicXor IntType VName VName (Count Elements (Imp.TExp Int64)) Exp - | AtomicCmpXchg PrimType VName VName (Count Elements (Imp.TExp Int64)) Exp Exp - | AtomicXchg PrimType VName VName (Count Elements (Imp.TExp Int64)) Exp + = AtomicAdd IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicFAdd FloatType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicSMax IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicSMin IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicUMax IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicUMin IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicAnd IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicOr IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicXor IntType VName VName (Count Elements (Imp.TExp Int32)) Exp + | AtomicCmpXchg PrimType VName VName (Count Elements (Imp.TExp Int32)) Exp Exp + | AtomicXchg PrimType VName VName (Count Elements (Imp.TExp Int32)) Exp deriving (Show) instance FreeIn AtomicOp where diff --git a/src/Futhark/CodeGen/ImpGen.hs b/src/Futhark/CodeGen/ImpGen.hs --- a/src/Futhark/CodeGen/ImpGen.hs +++ b/src/Futhark/CodeGen/ImpGen.hs @@ -156,9 +156,9 @@ type CopyCompiler lore r op = PrimType -> MemLocation -> - Slice (Imp.TExp Int64) -> + Slice (Imp.TExp Int32) -> MemLocation -> - Slice (Imp.TExp Int64) -> + Slice (Imp.TExp Int32) -> ImpM lore r op () -- | An alternate way of compiling an allocation. @@ -191,7 +191,7 @@ data MemLocation = MemLocation { memLocationName :: VName, memLocationShape :: [Imp.DimSize], - memLocationIxFun :: IxFun.IxFun (Imp.TExp Int64) + memLocationIxFun :: IxFun.IxFun (Imp.TExp Int32) } deriving (Eq, Show) @@ -621,7 +621,7 @@ Nothing -> do out <- imp $ newVName "out_arrsize" tell - ( [Imp.ScalarParam out int64], + ( [Imp.ScalarParam out int32], M.singleton x $ ScalarDestination out ) put (memseen, M.insert x out arrseen) @@ -773,7 +773,7 @@ ForLoop i _ bound loopvars -> do let setLoopParam (p, a) | Prim _ <- paramType p = - copyDWIM (paramName p) [] (Var a) [DimFix $ Imp.vi64 i] + copyDWIM (paramName p) [] (Var a) [DimFix $ Imp.vi32 i] | otherwise = return () @@ -828,22 +828,22 @@ uncurry warn loc "Safety check required at run-time." defCompileBasicOp (Pattern _ [pe]) (Index src slice) | Just idxs <- sliceIndices slice = - copyDWIM (patElemName pe) [] (Var src) $ map (DimFix . toInt64Exp) idxs + copyDWIM (patElemName pe) [] (Var src) $ map (DimFix . toInt32Exp) idxs defCompileBasicOp _ Index {} = return () defCompileBasicOp (Pattern _ [pe]) (Update _ slice se) = - sUpdate (patElemName pe) (map (fmap toInt64Exp) slice) se + sUpdate (patElemName pe) (map (fmap toInt32Exp) slice) se defCompileBasicOp (Pattern _ [pe]) (Replicate (Shape ds) se) = do ds' <- mapM toExp ds is <- replicateM (length ds) (newVName "i") - copy_elem <- collect $ copyDWIM (patElemName pe) (map (DimFix . Imp.vi64) is) se [] + copy_elem <- collect $ copyDWIM (patElemName pe) (map (DimFix . Imp.vi32) is) se [] emit $ foldl (.) id (zipWith Imp.For is ds') copy_elem defCompileBasicOp _ Scratch {} = return () defCompileBasicOp (Pattern [] [pe]) (Iota n e s it) = do e' <- toExp e s' <- toExp s - sFor "i" (toInt64Exp n) $ \i -> do + sFor "i" (toInt32Exp n) $ \i -> do let i' = sExt it $ untyped i x <- dPrimV "x" $ @@ -856,16 +856,16 @@ defCompileBasicOp (Pattern _ [pe]) (Manifest _ src) = copyDWIM (patElemName pe) [] (Var src) [] defCompileBasicOp (Pattern _ [pe]) (Concat i x ys _) = do - offs_glb <- dPrimV "tmp_offs" 0 + offs_glb <- dPrimV "tmp_offs" (0 :: Imp.TExp Int32) forM_ (x : ys) $ \y -> do y_dims <- arrayDims <$> lookupType y let rows = case drop i y_dims of [] -> error $ "defCompileBasicOp Concat: empty array shape for " ++ pretty y - r : _ -> toInt64Exp r + r : _ -> toInt32Exp r skip_dims = take i y_dims sliceAllDim d = DimSlice 0 d 1 - skip_slices = map (sliceAllDim . toInt64Exp) skip_dims + skip_slices = map (sliceAllDim . toInt32Exp) skip_dims destslice = skip_slices ++ [DimSlice (tvExp offs_glb) rows 1] copyDWIM (patElemName pe) destslice (Var y) [] offs_glb <-- tvExp offs_glb + rows @@ -877,7 +877,7 @@ static_array <- newVNameForFun "static_array" emit $ Imp.DeclareArray static_array dest_space t $ Imp.ArrayValues vs let static_src = - MemLocation static_array [intConst Int64 $ fromIntegral $ length es] $ + MemLocation static_array [intConst Int32 $ fromIntegral $ length es] $ IxFun.iota [fromIntegral $ length es] entry = MemVar Nothing $ MemEntry dest_space addVar static_array entry @@ -1216,7 +1216,7 @@ fullyIndexArray :: VName -> - [Imp.TExp Int64] -> + [Imp.TExp Int32] -> ImpM lore r op (VName, Imp.Space, Count Elements (Imp.TExp Int64)) fullyIndexArray name indices = do arr <- lookupArray name @@ -1224,7 +1224,7 @@ fullyIndexArray' :: MemLocation -> - [Imp.TExp Int64] -> + [Imp.TExp Int32] -> ImpM lore r op (VName, Imp.Space, Count Elements (Imp.TExp Int64)) fullyIndexArray' (MemLocation mem _ ixfun) indices = do space <- entryMemSpace <$> lookupMemory mem @@ -1233,10 +1233,13 @@ let (zero_is, is) = splitFromEnd (length ds) indices in map (const 0) zero_is ++ is _ -> indices + + ixfun64 = fmap sExt64 ixfun + indices64 = fmap sExt64 indices' return ( mem, space, - elements $ IxFun.index ixfun indices' + elements $ IxFun.index ixfun64 indices64 ) -- More complicated read/write operations that use index functions. @@ -1250,15 +1253,15 @@ isMapTransposeCopy :: PrimType -> MemLocation -> - Slice (Imp.TExp Int64) -> + Slice (Imp.TExp Int32) -> MemLocation -> - Slice (Imp.TExp Int64) -> + Slice (Imp.TExp Int32) -> Maybe - ( Imp.TExp Int64, - Imp.TExp Int64, - Imp.TExp Int64, - Imp.TExp Int64, - Imp.TExp Int64 + ( Imp.TExp Int32, + Imp.TExp Int32, + Imp.TExp Int32, + Imp.TExp Int32, + Imp.TExp Int32 ) isMapTransposeCopy bt @@ -1331,16 +1334,16 @@ $ transposeArgs pt destmem - (bytes destoffset) + (bytes $ sExt64 destoffset) srcmem - (bytes srcoffset) - num_arrays - size_x - size_y + (bytes $ sExt64 srcoffset) + (sExt64 num_arrays) + (sExt64 size_x) + (sExt64 size_y) | Just destoffset <- - IxFun.linearWithOffset (IxFun.slice dest_ixfun destslice) pt_size, + IxFun.linearWithOffset (IxFun.slice dest_ixfun64 destslice64) pt_size, Just srcoffset <- - IxFun.linearWithOffset (IxFun.slice src_ixfun srcslice) pt_size = do + IxFun.linearWithOffset (IxFun.slice src_ixfun64 srcslice64) pt_size = do srcspace <- entryMemSpace <$> lookupMemory srcmem destspace <- entryMemSpace <$> lookupMemory destmem if isScalarSpace srcspace || isScalarSpace destspace @@ -1364,6 +1367,11 @@ MemLocation destmem _ dest_ixfun = dest MemLocation srcmem _ src_ixfun = src + dest_ixfun64 = fmap sExt64 dest_ixfun + destslice64 = map (fmap sExt64) destslice + src_ixfun64 = fmap sExt64 src_ixfun + srcslice64 = map (fmap sExt64) srcslice + isScalarSpace ScalarSpace {} = True isScalarSpace _ = False @@ -1371,7 +1379,7 @@ copyElementWise bt dest destslice src srcslice = do let bounds = sliceDims srcslice is <- replicateM (length bounds) (newVName "i") - let ivars = map Imp.vi64 is + let ivars = map Imp.vi32 is (destmem, destspace, destidx) <- fullyIndexArray' dest $ fixSlice destslice ivars (srcmem, srcspace, srcidx) <- @@ -1387,9 +1395,9 @@ copyArrayDWIM :: PrimType -> MemLocation -> - [DimIndex (Imp.TExp Int64)] -> + [DimIndex (Imp.TExp Int32)] -> MemLocation -> - [DimIndex (Imp.TExp Int64)] -> + [DimIndex (Imp.TExp Int32)] -> ImpM lore r op (Imp.Code op) copyArrayDWIM bt @@ -1411,9 +1419,9 @@ Imp.index srcmem srcoffset bt srcspace vol | otherwise = do let destslice' = - fullSliceNum (map toInt64Exp destshape) destslice + fullSliceNum (map toInt32Exp destshape) destslice srcslice' = - fullSliceNum (map toInt64Exp srcshape) srcslice + fullSliceNum (map toInt32Exp srcshape) srcslice destrank = length $ sliceDims destslice' srcrank = length $ sliceDims srcslice' if destrank /= srcrank @@ -1437,9 +1445,9 @@ -- instead of a variable name. copyDWIMDest :: ValueDestination -> - [DimIndex (Imp.TExp Int64)] -> + [DimIndex (Imp.TExp Int32)] -> SubExp -> - [DimIndex (Imp.TExp Int64)] -> + [DimIndex (Imp.TExp Int32)] -> ImpM lore r op () copyDWIMDest _ _ (Constant v) (_ : _) = error $ @@ -1531,9 +1539,9 @@ -- Thing. Both destination and source must be in scope. copyDWIM :: VName -> - [DimIndex (Imp.TExp Int64)] -> + [DimIndex (Imp.TExp Int32)] -> SubExp -> - [DimIndex (Imp.TExp Int64)] -> + [DimIndex (Imp.TExp Int32)] -> ImpM lore r op () copyDWIM dest dest_slice src src_slice = do dest_entry <- lookupVar dest @@ -1550,9 +1558,9 @@ -- | As 'copyDWIM', but implicitly 'DimFix'es the indexes. copyDWIMFix :: VName -> - [Imp.TExp Int64] -> + [Imp.TExp Int32] -> SubExp -> - [Imp.TExp Int64] -> + [Imp.TExp Int32] -> ImpM lore r op () copyDWIMFix dest dest_is src src_is = copyDWIM dest (map DimFix dest_is) src (map DimFix src_is) @@ -1581,7 +1589,7 @@ typeSize t = Imp.bytes $ isInt64 (Imp.LeafExp (Imp.SizeOf $ elemType t) int64) - * product (map (sExt64 . toInt64Exp) (arrayDims t)) + * product (map (sExt64 . toInt32Exp) (arrayDims t)) --- Building blocks for constructing code. @@ -1656,14 +1664,14 @@ sArrayInMem name pt shape mem = sArray name pt shape $ ArrayIn mem $ - IxFun.iota $ map (isInt64 . primExpFromSubExp int64) $ shapeDims shape + IxFun.iota $ map (isInt32 . primExpFromSubExp int32) $ shapeDims shape -- | Like 'sAllocArray', but permute the in-memory representation of the indices as specified. sAllocArrayPerm :: String -> PrimType -> ShapeBase SubExp -> Space -> [Int] -> ImpM lore r op VName sAllocArrayPerm name pt shape space perm = do let permuted_dims = rearrangeShape perm $ shapeDims shape mem <- sAlloc (name ++ "_mem") (typeSize (Array pt shape NoUniqueness)) space - let iota_ixfun = IxFun.iota $ map (isInt64 . primExpFromSubExp int64) permuted_dims + let iota_ixfun = IxFun.iota $ map (isInt32 . primExpFromSubExp int32) permuted_dims sArray name pt shape $ ArrayIn mem $ IxFun.permute iota_ixfun $ rearrangeInverse perm @@ -1678,30 +1686,30 @@ let num_elems = case vs of Imp.ArrayValues vs' -> length vs' Imp.ArrayZeros n -> fromIntegral n - shape = Shape [intConst Int64 $ toInteger num_elems] + shape = Shape [intConst Int32 $ toInteger num_elems] mem <- newVNameForFun $ name ++ "_mem" emit $ Imp.DeclareArray mem space pt vs addVar mem $ MemVar Nothing $ MemEntry space sArray name pt shape $ ArrayIn mem $ IxFun.iota [fromIntegral num_elems] -sWrite :: VName -> [Imp.TExp Int64] -> Imp.Exp -> ImpM lore r op () +sWrite :: VName -> [Imp.TExp Int32] -> Imp.Exp -> ImpM lore r op () sWrite arr is v = do (mem, space, offset) <- fullyIndexArray arr is vol <- asks envVolatility emit $ Imp.Write mem offset (primExpType v) space vol v -sUpdate :: VName -> Slice (Imp.TExp Int64) -> SubExp -> ImpM lore r op () +sUpdate :: VName -> Slice (Imp.TExp Int32) -> SubExp -> ImpM lore r op () sUpdate arr slice v = copyDWIM arr slice v [] sLoopNest :: Shape -> - ([Imp.TExp Int64] -> ImpM lore r op ()) -> + ([Imp.TExp Int32] -> ImpM lore r op ()) -> ImpM lore r op () sLoopNest = sLoopNest' [] . shapeDims where sLoopNest' is [] f = f $ reverse is sLoopNest' is (d : ds) f = - sFor "nest_i" (toInt64Exp d) $ \i -> sLoopNest' (i : is) ds f + sFor "nest_i" (toInt32Exp d) $ \i -> sLoopNest' (i : is) ds f -- | Untyped assignment. (<~~) :: VName -> Imp.Exp -> ImpM lore r op () diff --git a/src/Futhark/CodeGen/ImpGen/Kernels.hs b/src/Futhark/CodeGen/ImpGen/Kernels.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels.hs @@ -188,7 +188,7 @@ x' <- toExp x s' <- toExp s - sIota (patElemName pe) (toInt64Exp n) x' s' et + sIota (patElemName pe) (toInt32Exp n) x' s' et expCompiler (Pattern _ [pe]) (BasicOp (Replicate _ se)) = sReplicate (patElemName pe) se -- Allocation in the "local" space is just a placeholder. @@ -243,7 +243,7 @@ IxFun.linearWithOffset (IxFun.slice destIxFun destslice) bt_size, Just srcoffset <- IxFun.linearWithOffset (IxFun.slice srcIxFun srcslice) bt_size = do - let num_elems = Imp.elements $ product $ map toInt64Exp srcshape + let num_elems = Imp.elements $ product $ map toInt32Exp srcshape srcspace <- entryMemSpace <$> lookupMemory srcmem destspace <- entryMemSpace <$> lookupMemory destmem emit $ diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/Base.hs b/src/Futhark/CodeGen/ImpGen/Kernels/Base.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels/Base.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels/Base.hs @@ -68,8 +68,8 @@ kernelGlobalThreadIdVar :: VName, kernelLocalThreadIdVar :: VName, kernelGroupIdVar :: VName, - kernelNumGroups :: Imp.TExp Int64, - kernelGroupSize :: Imp.TExp Int64, + kernelNumGroups :: Imp.TExp Int32, + kernelGroupSize :: Imp.TExp Int32, kernelNumThreads :: Imp.TExp Int32, kernelWaveSize :: Imp.TExp Int32, kernelThreadActive :: Imp.TExp Bool, @@ -102,7 +102,7 @@ localEnv f m where mkMap ltid dims = do - let dims' = map (sExt32 . toInt64Exp) dims + let dims' = map toInt32Exp dims ids' <- mapM (dPrimVE "ltid_pre") $ unflattenIndex dims' ltid return (dims, ids') @@ -140,16 +140,16 @@ ImpM lore r op () splitSpace (Pattern [] [size]) o w i elems_per_thread = do num_elements <- Imp.elements . TPrimExp <$> toExp w - let i' = toInt64Exp i + let i' = toInt32Exp i elems_per_thread' <- Imp.elements . TPrimExp <$> toExp elems_per_thread - computeThreadChunkSize o i' elems_per_thread' num_elements (mkTV (patElemName size) int64) + computeThreadChunkSize o i' elems_per_thread' num_elements (mkTV (patElemName size) int32) splitSpace pat _ _ _ _ = error $ "Invalid target for splitSpace: " ++ pretty pat compileThreadExp :: ExpCompiler KernelsMem KernelEnv Imp.KernelOp compileThreadExp (Pattern _ [dest]) (BasicOp (ArrayLit es _)) = forM_ (zip [0 ..] es) $ \(i, e) -> - copyDWIMFix (patElemName dest) [fromIntegral (i :: Int64)] e [] + copyDWIMFix (patElemName dest) [fromIntegral (i :: Int32)] e [] compileThreadExp dest e = defCompileExp dest e @@ -179,13 +179,13 @@ -- passed-in function is invoked with the (symbolic) iteration. For -- multidimensional loops, use 'groupCoverSpace'. groupLoop :: - Imp.TExp Int64 -> - (Imp.TExp Int64 -> InKernelGen ()) -> + Imp.TExp Int32 -> + (Imp.TExp Int32 -> InKernelGen ()) -> InKernelGen () groupLoop n f = do constants <- kernelConstants <$> askEnv kernelLoop - (sExt64 $ kernelLocalThreadId constants) + (kernelLocalThreadId constants) (kernelGroupSize constants) n f @@ -194,8 +194,8 @@ -- all threads in the group participate. The passed-in function is -- invoked with a (symbolic) point in the index space. groupCoverSpace :: - [Imp.TExp Int64] -> - ([Imp.TExp Int64] -> InKernelGen ()) -> + [Imp.TExp Int32] -> + ([Imp.TExp Int32] -> InKernelGen ()) -> InKernelGen () groupCoverSpace ds f = groupLoop (product ds) $ f . unflattenIndex ds @@ -204,9 +204,9 @@ -- The static arrays stuff does not work inside kernels. compileGroupExp (Pattern _ [dest]) (BasicOp (ArrayLit es _)) = forM_ (zip [0 ..] es) $ \(i, e) -> - copyDWIMFix (patElemName dest) [fromIntegral (i :: Int64)] e [] + copyDWIMFix (patElemName dest) [fromIntegral (i :: Int32)] e [] compileGroupExp (Pattern _ [dest]) (BasicOp (Replicate ds se)) = do - let ds' = map toInt64Exp $ shapeDims ds + let ds' = map toInt32Exp $ shapeDims ds groupCoverSpace ds' $ \is -> copyDWIMFix (patElemName dest) is se (drop (shapeRank ds) is) sOp $ Imp.Barrier Imp.FenceLocal @@ -232,7 +232,7 @@ sOp $ Imp.Barrier Imp.FenceLocal ltid <- kernelLocalThreadId . kernelConstants <$> askEnv sWhen (ltid .==. 0) $ - copyDWIM (patElemName pe) (map (fmap toInt64Exp) slice) se [] + copyDWIM (patElemName pe) (map (fmap toInt32Exp) slice) se [] sOp $ Imp.Barrier Imp.FenceLocal compileGroupExp dest e = defCompileExp dest e @@ -242,11 +242,11 @@ sanityCheckLevel SegGroup {} = error "compileGroupOp: unexpected group-level SegOp." -localThreadIDs :: [SubExp] -> InKernelGen [Imp.TExp Int64] +localThreadIDs :: [SubExp] -> InKernelGen [Imp.TExp Int32] localThreadIDs dims = do - ltid <- sExt64 . kernelLocalThreadId . kernelConstants <$> askEnv - let dims' = map toInt64Exp dims - maybe (unflattenIndex dims' ltid) (map sExt64) + ltid <- kernelLocalThreadId . kernelConstants <$> askEnv + let dims' = map toInt32Exp dims + fromMaybe (unflattenIndex dims' ltid) . M.lookup dims . kernelLocalIdMap . kernelConstants @@ -264,7 +264,7 @@ prepareIntraGroupSegHist :: Count GroupSize SubExp -> [HistOp KernelsMem] -> - InKernelGen [[Imp.TExp Int64] -> InKernelGen ()] + InKernelGen [[Imp.TExp Int32] -> InKernelGen ()] prepareIntraGroupSegHist group_size = fmap snd . mapAccumLM onOp Nothing where @@ -281,8 +281,8 @@ (Nothing, AtomicLocking f) -> do locks <- newVName "locks" - let num_locks = toInt64Exp $ unCount group_size - dims = map toInt64Exp $ shapeDims (histShape op) ++ [histWidth op] + let num_locks = toInt32Exp $ unCount group_size + dims = map toInt32Exp $ shapeDims (histShape op) ++ [histWidth op] l' = Locking locks 0 1 0 (pure . (`rem` num_locks) . flattenIndex dims) locks_t = Array int32 (Shape [unCount group_size]) NoUniqueness @@ -290,7 +290,7 @@ dArray locks int32 (arrayShape locks_t) $ ArrayIn locks_mem $ IxFun.iota $ - map pe64 $ arrayDims locks_t + map pe32 $ arrayDims locks_t sComment "All locks start out unlocked" $ groupCoverSpace [kernelGroupSize constants] $ \is -> @@ -321,22 +321,21 @@ compileGroupOp pat (Inner (SegOp (SegScan lvl space scans _ body))) = do compileGroupSpace lvl space let (ltids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims whenActive lvl space $ compileStms mempty (kernelBodyStms body) $ forM_ (zip (patternNames pat) $ kernelBodyResult body) $ \(dest, res) -> copyDWIMFix dest - (map Imp.vi64 ltids) + (map Imp.vi32 ltids) (kernelResultSubExp res) [] sOp $ Imp.ErrorSync Imp.FenceLocal let segment_size = last dims' - crossesSegment from to = - (sExt64 to - sExt64 from) .>. (sExt64 to `rem` segment_size) + crossesSegment from to = (to - from) .>. (to `rem` segment_size) -- groupScan needs to treat the scan output as a one-dimensional -- array of scan elements, so we invent some new flattened arrays @@ -352,7 +351,7 @@ (baseString (patElemName pe) ++ "_flat") (elemType pe_t) (Shape arr_dims) - $ ArrayIn mem $ IxFun.iota $ map pe64 arr_dims + $ ArrayIn mem $ IxFun.iota $ map pe32 arr_dims num_scan_results = sum $ map (length . segBinOpNeutral) scans @@ -368,7 +367,7 @@ (red_pes, map_pes) = splitAt (segBinOpResults ops) $ patternElements pat - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims mkTempArr t = sAllocArray "red_arr" (elemType t) (Shape dims <> arrayShape t) $ Space "local" @@ -381,7 +380,7 @@ let (red_res, map_res) = splitAt (segBinOpResults ops) $ kernelBodyResult body forM_ (zip tmp_arrs red_res) $ \(dest, res) -> - copyDWIMFix dest (map Imp.vi64 ltids) (kernelResultSubExp res) [] + copyDWIMFix dest (map Imp.vi32 ltids) (kernelResultSubExp res) [] zipWithM_ (compileThreadResult space) map_pes map_res sOp $ Imp.ErrorSync Imp.FenceLocal @@ -391,7 +390,7 @@ -- handle directly with a group-level reduction. [dim'] -> do forM_ (zip ops tmps_for_ops) $ \(op, tmps) -> - groupReduce (sExt32 dim') (segBinOpLambda op) tmps + groupReduce dim' (segBinOpLambda op) tmps sOp $ Imp.ErrorSync Imp.FenceLocal @@ -414,11 +413,10 @@ drop (length ltids) (memLocationShape arr_loc) sArray "red_arr_flat" pt flat_shape $ ArrayIn (memLocationName arr_loc) $ - IxFun.iota $ map pe64 $ shapeDims flat_shape + IxFun.iota $ map pe32 $ shapeDims flat_shape let segment_size = last dims' - crossesSegment from to = - (sExt64 to - sExt64 from) .>. (sExt64 to `rem` sExt64 segment_size) + crossesSegment from to = (to - from) .>. (to `rem` segment_size) forM_ (zip ops tmps_for_ops) $ \(op, tmps) -> do tmps_flat <- mapM flatten tmps @@ -465,10 +463,10 @@ forM_ (zip4 red_is vs_per_op ops' ops) $ \(bin, op_vs, do_op, HistOp dest_w _ _ _ shape lam) -> do - let bin' = toInt64Exp bin - dest_w' = toInt64Exp dest_w + let bin' = toInt32Exp bin + dest_w' = toInt32Exp dest_w bin_in_bounds = 0 .<=. bin' .&&. bin' .<. dest_w' - bin_is = map Imp.vi64 (init ltids) ++ [bin'] + bin_is = map Imp.vi32 (init ltids) ++ [bin'] vs_params = takeLast (length op_vs) $ lambdaParams lam sComment "perform atomic updates" $ @@ -504,13 +502,13 @@ -- | A transformation from the logical lock index to the -- physical position in the array. This can also be used -- to make the lock array smaller. - lockingMapping :: [Imp.TExp Int64] -> [Imp.TExp Int64] + lockingMapping :: [Imp.TExp Int32] -> [Imp.TExp Int32] } -- | A function for generating code for an atomic update. Assumes -- that the bucket is in-bounds. type DoAtomicUpdate lore r = - Space -> [VName] -> [Imp.TExp Int64] -> ImpM lore r Imp.KernelOp () + Space -> [VName] -> [Imp.TExp Int32] -> ImpM lore r Imp.KernelOp () -- | The mechanism that will be used for performing the atomic update. -- Approximates how efficient it will be. Ordered from most to least @@ -526,7 +524,7 @@ -- | Is there an atomic t'BinOp' corresponding to this t'BinOp'? type AtomicBinOp = BinOp -> - Maybe (VName -> VName -> Count Imp.Elements (Imp.TExp Int64) -> Imp.Exp -> Imp.AtomicOp) + Maybe (VName -> VName -> Count Imp.Elements (Imp.TExp Int32) -> Imp.Exp -> Imp.AtomicOp) -- | Do an atomic update corresponding to a binary operator lambda. atomicUpdateLocking :: @@ -548,7 +546,7 @@ (arr', _a_space, bucket_offset) <- fullyIndexArray a bucket - case opHasAtomicSupport space (tvVar old) arr' bucket_offset op of + case opHasAtomicSupport space (tvVar old) arr' (sExt32 <$> bucket_offset) op of Just f -> sOp $ f $ Imp.var y t Nothing -> atomicUpdateCAS space t a (tvVar old) bucket x $ @@ -590,7 +588,7 @@ int32 (tvVar old) locks' - locks_offset + (sExt32 <$> locks_offset) (untyped $ lockingIsUnlocked locking) (untyped $ lockingToLock locking) lock_acquired = tvExp old .==. lockingIsUnlocked locking @@ -603,7 +601,7 @@ int32 (tvVar old) locks' - locks_offset + (sExt32 <$> locks_offset) (untyped $ lockingToLock locking) (untyped $ lockingToUnlock locking) break_loop = continue <-- false @@ -658,7 +656,7 @@ PrimType -> VName -> VName -> - [Imp.TExp Int64] -> + [Imp.TExp Int32] -> VName -> InKernelGen () -> InKernelGen () @@ -700,7 +698,7 @@ int32 (tvVar old_bits) arr' - bucket_offset + (sExt32 <$> bucket_offset) (toBits (Imp.var assumed t)) (toBits (Imp.var x t)) old <~~ fromBits (untyped $ tvExp old_bits) @@ -775,16 +773,16 @@ computeThreadChunkSize :: SplitOrdering -> - Imp.TExp Int64 -> - Imp.Count Imp.Elements (Imp.TExp Int64) -> - Imp.Count Imp.Elements (Imp.TExp Int64) -> - TV Int64 -> + Imp.TExp Int32 -> + Imp.Count Imp.Elements (Imp.TExp Int32) -> + Imp.Count Imp.Elements (Imp.TExp Int32) -> + TV Int32 -> ImpM lore r op () computeThreadChunkSize (SplitStrided stride) thread_index elements_per_thread num_elements chunk_var = chunk_var - <-- sMin64 + <-- sMin32 (Imp.unCount elements_per_thread) - ((Imp.unCount num_elements - thread_index) `divUp` toInt64Exp stride) + ((Imp.unCount num_elements - thread_index) `divUp` toInt32Exp stride) computeThreadChunkSize SplitContiguous thread_index elements_per_thread num_elements chunk_var = do starting_point <- dPrimV "starting_point" $ @@ -798,7 +796,7 @@ sIf (no_remaining_elements .||. beyond_bounds) - (chunk_var <-- 0) + (chunk_var <-- (0 :: Imp.TExp Int32)) ( sIf is_last_thread (chunk_var <-- Imp.unCount last_thread_elements) @@ -812,8 +810,8 @@ .<. (thread_index + 1) * Imp.unCount elements_per_thread kernelInitialisationSimple :: - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> CallKernelGen (KernelConstants, InKernelGen ()) kernelInitialisationSimple (Count num_groups) (Count group_size) = do global_tid <- newVName "global_tid" @@ -831,7 +829,7 @@ group_id num_groups group_size - (sExt32 (group_size * num_groups)) + (group_size * num_groups) (Imp.vi32 wave_size) true mempty @@ -839,7 +837,7 @@ let set_constants = do dPrim_ global_tid int32 dPrim_ local_tid int32 - dPrim_ inner_group_size int64 + dPrim_ inner_group_size int32 dPrim_ wave_size int32 dPrim_ group_id int32 @@ -857,8 +855,8 @@ x : xs -> foldl (.&&.) x xs where (is, ws) = unzip limit - actives = zipWith active is $ map toInt64Exp ws - active i = (Imp.vi64 i .<.) + actives = zipWith active is $ map toInt32Exp ws + active i = (Imp.vi32 i .<.) -- | Change every memory block to be in the global address space, -- except those who are in the local memory space. This only affects @@ -903,20 +901,20 @@ readReduceArgument param arr | Prim _ <- paramType param = do let i = local_tid + tvExp offset - copyDWIMFix (paramName param) [] (Var arr) [sExt64 i] + copyDWIMFix (paramName param) [] (Var arr) [i] | otherwise = do let i = global_tid + tvExp offset - copyDWIMFix (paramName param) [] (Var arr) [sExt64 i] + copyDWIMFix (paramName param) [] (Var arr) [i] writeReduceOpResult param arr | Prim _ <- paramType param = - copyDWIMFix arr [sExt64 local_tid] (Var $ paramName param) [] + copyDWIMFix arr [local_tid] (Var $ paramName param) [] | otherwise = return () let (reduce_acc_params, reduce_arr_params) = splitAt (length arrs) $ lambdaParams lam - skip_waves <- dPrimV "skip_waves" (1 :: Imp.TExp Int32) + skip_waves <- dPrim "skip_waves" int32 dLParams $ lambdaParams lam offset <-- (0 :: Imp.TExp Int32) @@ -938,7 +936,7 @@ group_size = kernelGroupSize constants wave_id = local_tid `quot` wave_size in_wave_id = local_tid - wave_id * wave_size - num_waves = (sExt32 group_size + wave_size - 1) `quot` wave_size + num_waves = (group_size + wave_size - 1) `quot` wave_size arg_in_bounds = local_tid + tvExp offset .<. w doing_in_wave_reductions = @@ -961,7 +959,8 @@ (wave_id .&. (2 * tvExp skip_waves - 1)) .==. 0 apply_in_cross_wave_iteration = arg_in_bounds .&&. is_first_thread_in_wave .&&. wave_not_skipped - cross_wave_reductions = + cross_wave_reductions = do + skip_waves <-- (1 :: Imp.TExp Int32) sWhile doing_cross_wave_reductions $ do barrier offset <-- tvExp skip_waves * wave_size @@ -975,8 +974,8 @@ groupScan :: Maybe (Imp.TExp Int32 -> Imp.TExp Int32 -> Imp.TExp Bool) -> - Imp.TExp Int64 -> - Imp.TExp Int64 -> + Imp.TExp Int32 -> + Imp.TExp Int32 -> Lambda KernelsMem -> [VName] -> InKernelGen () @@ -984,14 +983,11 @@ constants <- kernelConstants <$> askEnv renamed_lam <- renameLambda lam - let ltid32 = kernelLocalThreadId constants - ltid = sExt64 ltid32 + let ltid = kernelLocalThreadId constants (x_params, y_params) = splitAt (length arrs) $ lambdaParams lam dLParams (lambdaParams lam ++ lambdaParams renamed_lam) - ltid_in_bounds <- dPrimVE "ltid_in_bounds" $ ltid .<. w - -- The scan works by splitting the group into blocks, which are -- scanned separately. Typically, these blocks are smaller than -- the lockstep width, which enables barrier-free execution inside @@ -1004,8 +1000,8 @@ -- it were a runtime parameter. Some day. let block_size = 32 simd_width = kernelWaveSize constants - block_id = ltid32 `quot` block_size - in_block_id = ltid32 - block_id * block_size + block_id = ltid `quot` block_size + in_block_id = ltid - block_id * block_size doInBlockScan seg_flag' active = inBlockScan constants @@ -1016,6 +1012,7 @@ active arrs barrier + ltid_in_bounds = ltid .<. w array_scan = not $ all primType $ lambdaReturnType lam barrier | array_scan = @@ -1023,19 +1020,19 @@ | otherwise = sOp $ Imp.Barrier Imp.FenceLocal - group_offset = sExt64 (kernelGroupId constants) * kernelGroupSize constants + group_offset = kernelGroupId constants * kernelGroupSize constants writeBlockResult p arr | primType $ paramType p = - copyDWIM arr [DimFix $ sExt64 block_id] (Var $ paramName p) [] + copyDWIM arr [DimFix block_id] (Var $ paramName p) [] | otherwise = - copyDWIM arr [DimFix $ group_offset + sExt64 block_id] (Var $ paramName p) [] + copyDWIM arr [DimFix $ group_offset + block_id] (Var $ paramName p) [] readPrevBlockResult p arr | primType $ paramType p = - copyDWIM (paramName p) [] (Var arr) [DimFix $ sExt64 block_id - 1] + copyDWIM (paramName p) [] (Var arr) [DimFix $ block_id - 1] | otherwise = - copyDWIM (paramName p) [] (Var arr) [DimFix $ group_offset + sExt64 block_id - 1] + copyDWIM (paramName p) [] (Var arr) [DimFix $ group_offset + block_id - 1] doInBlockScan seg_flag ltid_in_bounds lam barrier @@ -1046,7 +1043,7 @@ sWhen is_first_block $ forM_ (zip x_params arrs) $ \(x, arr) -> unless (primType $ paramType x) $ - copyDWIM arr [DimFix $ arrs_full_size + group_offset + sExt64 block_size + ltid] (Var $ paramName x) [] + copyDWIM arr [DimFix $ arrs_full_size + group_offset + block_size + ltid] (Var $ paramName x) [] barrier @@ -1077,7 +1074,7 @@ arr [DimFix $ arrs_full_size + group_offset + ltid] (Var arr) - [DimFix $ arrs_full_size + group_offset + sExt64 block_size + ltid] + [DimFix $ arrs_full_size + group_offset + block_size + ltid] barrier @@ -1095,7 +1092,7 @@ compileBody' x_params $ lambdaBody lam | Just flag_true <- seg_flag = do inactive <- - dPrimVE "inactive" $ flag_true (block_id * block_size -1) ltid32 + dPrimVE "inactive" $ flag_true (block_id * block_size -1) ltid sWhen inactive y_to_x when array_scan barrier sUnless inactive $ compileBody' x_params $ lambdaBody lam @@ -1125,9 +1122,9 @@ inBlockScan :: KernelConstants -> Maybe (Imp.TExp Int32 -> Imp.TExp Int32 -> Imp.TExp Bool) -> - Imp.TExp Int64 -> Imp.TExp Int32 -> Imp.TExp Int32 -> + Imp.TExp Int32 -> Imp.TExp Bool -> [VName] -> InKernelGen () -> @@ -1161,7 +1158,7 @@ | Just flag_true <- seg_flag = do inactive <- dPrimVE "inactive" $ - flag_true (ltid32 - tvExp skip_threads) ltid32 + flag_true (ltid - tvExp skip_threads) ltid sWhen inactive y_to_x when array_scan barrier sUnless inactive $ compileBody' x_params $ lambdaBody scan_lam @@ -1172,11 +1169,11 @@ barrier sComment "in-block scan (hopefully no barriers needed)" $ do - skip_threads <-- 1 + skip_threads <-- (1 :: Imp.TExp Int32) sWhile (tvExp skip_threads .<. block_size) $ do sWhen (in_block_thread_active .&&. active) $ do sComment "read operands" $ - zipWithM_ (readParam (sExt64 $ tvExp skip_threads)) x_params arrs + zipWithM_ (readParam (tvExp skip_threads)) x_params arrs sComment "perform operation" op_to_x maybeBarrier @@ -1189,11 +1186,10 @@ skip_threads <-- tvExp skip_threads * 2 where - block_id = ltid32 `quot` block_size - in_block_id = ltid32 - block_id * block_size - ltid32 = kernelLocalThreadId constants - ltid = sExt64 ltid32 - gtid = sExt64 $ kernelGlobalThreadId constants + block_id = ltid `quot` block_size + in_block_id = ltid - block_id * block_size + ltid = kernelLocalThreadId constants + gtid = kernelGlobalThreadId constants array_scan = not $ all primType $ lambdaReturnType scan_lam readInitial p arr @@ -1215,13 +1211,13 @@ | otherwise = copyDWIM (paramName y) [] (Var $ paramName x) [] -computeMapKernelGroups :: Imp.TExp Int64 -> CallKernelGen (Imp.TExp Int64, Imp.TExp Int64) +computeMapKernelGroups :: Imp.TExp Int64 -> CallKernelGen (Imp.TExp Int64, Imp.TExp Int32) computeMapKernelGroups kernel_size = do - group_size <- dPrim "group_size" int64 + group_size <- dPrim "group_size" int32 fname <- askFunction let group_size_key = keyWithEntryPoint fname $ nameFromString $ pretty $ tvVar group_size sOp $ Imp.GetSize (tvVar group_size) group_size_key Imp.SizeGroup - num_groups <- dPrimV "num_groups" $ kernel_size `divUp` tvExp group_size + num_groups <- dPrimV "num_groups" $ kernel_size `divUp` sExt64 (tvExp group_size) return (tvExp num_groups, tvExp group_size) simpleKernelConstants :: @@ -1249,9 +1245,9 @@ thread_gtid thread_ltid group_id - num_groups + (sExt32 num_groups) group_size - (sExt32 (group_size * num_groups)) + (group_size * sExt32 num_groups) 0 (Imp.vi64 thread_gtid .<. kernel_size) mempty, @@ -1276,13 +1272,13 @@ sOp $ Imp.GetGroupId (tvVar phys_group_id) 0 let iterations = (required_groups - tvExp phys_group_id) - `divUp` sExt32 (kernelNumGroups constants) + `divUp` kernelNumGroups constants sFor "i" iterations $ \i -> do m . tvExp =<< dPrimV "virt_group_id" - (tvExp phys_group_id + i * sExt32 (kernelNumGroups constants)) + (tvExp phys_group_id + i * kernelNumGroups constants) -- Make sure the virtual group is actually done before we let -- another virtual group have its way with it. sOp $ Imp.Barrier Imp.FenceGlobal @@ -1292,8 +1288,8 @@ sKernelThread :: String -> - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> VName -> InKernelGen () -> CallKernelGen () @@ -1301,8 +1297,8 @@ sKernelGroup :: String -> - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> VName -> InKernelGen () -> CallKernelGen () @@ -1335,8 +1331,8 @@ Operations KernelsMem KernelEnv Imp.KernelOp -> (KernelConstants -> Imp.TExp Int32) -> String -> - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> VName -> InKernelGen () -> CallKernelGen () @@ -1396,7 +1392,7 @@ t <- subExpType se ds <- dropLast (arrayRank t) . arrayDims <$> lookupType arr - let dims = map toInt64Exp $ ds ++ arrayDims t + let dims = map toInt32Exp $ ds ++ arrayDims t (constants, set_constants) <- simpleKernelConstants (product $ map sExt64 dims) "replicate" @@ -1405,7 +1401,7 @@ keyWithEntryPoint fname $ nameFromString $ "replicate_" ++ show (baseTag $ kernelGlobalThreadIdVar constants) - is' = unflattenIndex dims $ sExt64 $ kernelGlobalThreadId constants + is' = unflattenIndex dims $ kernelGlobalThreadId constants sKernelFailureTolerant True threadOperations constants name $ do set_constants @@ -1436,7 +1432,7 @@ sArray "arr" bt shape $ ArrayIn mem $ IxFun.iota $ - map pe64 $ shapeDims shape + map pe32 $ shapeDims shape sReplicateKernel arr $ Var val return fname @@ -1455,7 +1451,7 @@ [] fname [ Imp.MemArg arr_mem, - Imp.ExpArg $ untyped $ product $ map toInt64Exp arr_shape, + Imp.ExpArg $ untyped $ product $ map toInt32Exp arr_shape, Imp.ExpArg $ toExp' v_t' v ] _ -> return Nothing @@ -1492,7 +1488,7 @@ sKernelFailureTolerant True threadOperations constants name $ do set_constants - let gtid = sExt64 $ kernelGlobalThreadId constants + let gtid = kernelGlobalThreadId constants sWhen (kernelThreadActive constants) $ do (destmem, destspace, destidx) <- fullyIndexArray' destloc [gtid] @@ -1524,7 +1520,7 @@ Imp.ScalarParam s $ IntType bt ] shape = Shape [Var n] - n' = Imp.vi64 n + n' = Imp.vi32 n x' = Imp.var x $ IntType bt s' = Imp.var s $ IntType bt @@ -1533,7 +1529,7 @@ sArray "arr" (IntType bt) shape $ ArrayIn mem $ IxFun.iota $ - map pe64 $ shapeDims shape + map pe32 $ shapeDims shape sIotaKernel arr (sExt64 n') x' s' bt return fname @@ -1541,7 +1537,7 @@ -- | Perform an Iota with a kernel. sIota :: VName -> - Imp.TExp Int64 -> + Imp.TExp Int32 -> Imp.Exp -> Imp.Exp -> IntType -> @@ -1556,7 +1552,7 @@ [] fname [Imp.MemArg arr_mem, Imp.ExpArg $ untyped n, Imp.ExpArg x, Imp.ExpArg s] - else sIotaKernel arr n x s et + else sIotaKernel arr (sExt64 n) x s et sCopy :: CopyCompiler KernelsMem HostEnv Imp.HostOp sCopy @@ -1569,7 +1565,7 @@ -- Note that the shape of the destination and the source are -- necessarily the same. let shape = sliceDims srcslice - kernel_size = product shape + kernel_size = product $ map sExt64 shape (constants, set_constants) <- simpleKernelConstants kernel_size "copy" @@ -1582,7 +1578,7 @@ sKernelFailureTolerant True threadOperations constants name $ do set_constants - let gtid = sExt64 $ kernelGlobalThreadId constants + let gtid = kernelGlobalThreadId constants dest_is = unflattenIndex shape gtid src_is = dest_is @@ -1591,7 +1587,7 @@ (_, srcspace, srcidx) <- fullyIndexArray' srcloc $ fixSlice srcslice src_is - sWhen (gtid .<. kernel_size) $ + sWhen (gtid .<. sExt32 kernel_size) $ emit $ Imp.Write destmem destidx bt destspace Imp.Nonvolatile $ Imp.index srcmem srcidx bt srcspace Imp.Nonvolatile @@ -1602,29 +1598,26 @@ KernelResult -> InKernelGen () compileGroupResult _ pe (TileReturns [(w, per_group_elems)] what) = do - n <- toInt64Exp . arraySize 0 <$> lookupType what + n <- toInt32Exp . arraySize 0 <$> lookupType what constants <- kernelConstants <$> askEnv - let ltid = sExt64 $ kernelLocalThreadId constants - offset = - toInt64Exp per_group_elems - * sExt64 (kernelGroupId constants) + let ltid = kernelLocalThreadId constants + offset = toInt32Exp per_group_elems * kernelGroupId constants -- Avoid loop for the common case where each thread is statically -- known to write at most one element. localOps threadOperations $ - if toInt64Exp per_group_elems == kernelGroupSize constants + if toInt32Exp per_group_elems == kernelGroupSize constants then - sWhen (ltid + offset .<. toInt64Exp w) $ + sWhen (offset + ltid .<. toInt32Exp w) $ copyDWIMFix (patElemName pe) [ltid + offset] (Var what) [ltid] else sFor "i" (n `divUp` kernelGroupSize constants) $ \i -> do j <- dPrimVE "j" $ kernelGroupSize constants * i + ltid - sWhen (j + offset .<. toInt64Exp w) $ - copyDWIMFix (patElemName pe) [j + offset] (Var what) [j] + sWhen (j .<. n) $ copyDWIMFix (patElemName pe) [j + offset] (Var what) [j] compileGroupResult space pe (TileReturns dims what) = do let gids = map fst $ unSegSpace space - out_tile_sizes = map (toInt64Exp . snd) dims - group_is = zipWith (*) (map Imp.vi64 gids) out_tile_sizes + out_tile_sizes = map (toInt32Exp . snd) dims + group_is = zipWith (*) (map Imp.vi32 gids) out_tile_sizes local_is <- localThreadIDs $ map snd dims is_for_thread <- mapM (dPrimV "thread_out_index") $ @@ -1636,7 +1629,7 @@ compileGroupResult space pe (Returns _ what) = do constants <- kernelConstants <$> askEnv in_local_memory <- arrayInLocalMemory what - let gids = map (Imp.vi64 . fst) $ unSegSpace space + let gids = map (Imp.vi32 . fst) $ unSegSpace space if not in_local_memory then @@ -1659,24 +1652,22 @@ KernelResult -> InKernelGen () compileThreadResult space pe (Returns _ what) = do - let is = map (Imp.vi64 . fst) $ unSegSpace space + let is = map (Imp.vi32 . fst) $ unSegSpace space copyDWIMFix (patElemName pe) is what [] compileThreadResult _ pe (ConcatReturns SplitContiguous _ per_thread_elems what) = do constants <- kernelConstants <$> askEnv - let offset = - toInt64Exp per_thread_elems - * sExt64 (kernelGlobalThreadId constants) - n <- toInt64Exp . arraySize 0 <$> lookupType what + let offset = toInt32Exp per_thread_elems * kernelGlobalThreadId constants + n <- toInt32Exp . arraySize 0 <$> lookupType what copyDWIM (patElemName pe) [DimSlice offset n 1] (Var what) [] compileThreadResult _ pe (ConcatReturns (SplitStrided stride) _ _ what) = do - offset <- sExt64 . kernelGlobalThreadId . kernelConstants <$> askEnv - n <- toInt64Exp . arraySize 0 <$> lookupType what - copyDWIM (patElemName pe) [DimSlice offset n $ toInt64Exp stride] (Var what) [] + offset <- kernelGlobalThreadId . kernelConstants <$> askEnv + n <- toInt32Exp . arraySize 0 <$> lookupType what + copyDWIM (patElemName pe) [DimSlice offset n $ toInt32Exp stride] (Var what) [] compileThreadResult _ pe (WriteReturns rws _arr dests) = do constants <- kernelConstants <$> askEnv - let rws' = map toInt64Exp rws + let rws' = map toInt32Exp rws forM_ dests $ \(slice, e) -> do - let slice' = map (fmap toInt64Exp) slice + let slice' = map (fmap toInt32Exp) slice condInBounds (DimFix i) rw = 0 .<=. i .&&. i .<. rw condInBounds (DimSlice i n s) rw = diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegHist.hs @@ -62,22 +62,23 @@ data SegHistSlug = SegHistSlug { slugOp :: HistOp KernelsMem, - slugNumSubhistos :: TV Int64, + slugNumSubhistos :: TV Int32, slugSubhistos :: [SubhistosInfo], slugAtomicUpdate :: AtomicUpdate KernelsMem KernelEnv } histoSpaceUsage :: HistOp KernelsMem -> - Imp.Count Imp.Bytes (Imp.TExp Int64) + Imp.Count Imp.Bytes (Imp.TExp Int32) histoSpaceUsage op = - sum $ - map - ( typeSize - . (`arrayOfRow` histWidth op) - . (`arrayOfShape` histShape op) - ) - $ lambdaReturnType $ histOp op + fmap sExt32 $ + sum $ + map + ( typeSize + . (`arrayOfRow` histWidth op) + . (`arrayOfShape` histShape op) + ) + $ lambdaReturnType $ histOp op -- | Figure out how much memory is needed per histogram, both -- segmented and unsegmented,, and compute some other auxiliary @@ -86,8 +87,8 @@ SegSpace -> HistOp KernelsMem -> CallKernelGen - ( Imp.Count Imp.Bytes (Imp.TExp Int64), - Imp.Count Imp.Bytes (Imp.TExp Int64), + ( Imp.Count Imp.Bytes (Imp.TExp Int32), + Imp.Count Imp.Bytes (Imp.TExp Int32), SegHistSlug ) computeHistoUsage space op = do @@ -110,7 +111,7 @@ subhistos_membind = ArrayIn subhistos_mem $ IxFun.iota $ - map pe64 $ shapeDims subhistos_shape + map pe32 $ shapeDims subhistos_shape subhistos <- sArray (baseString dest ++ "_subhistos") @@ -127,8 +128,8 @@ multiHistoCase = do let num_elems = - foldl' (*) (sExt64 $ tvExp num_subhistos) $ - map toInt64Exp $ arrayDims dest_t + foldl' (*) (tvExp num_subhistos) $ + map toInt32Exp $ arrayDims dest_t let subhistos_mem_size = Imp.bytes $ @@ -138,15 +139,15 @@ sReplicate subhistos ne subhistos_t <- lookupType subhistos let slice = - fullSliceNum (map toInt64Exp $ arrayDims subhistos_t) $ - map (unitSlice 0 . toInt64Exp . snd) segment_dims + fullSliceNum (map toInt32Exp $ arrayDims subhistos_t) $ + map (unitSlice 0 . toInt32Exp . snd) segment_dims ++ [DimFix 0] sUpdate subhistos slice $ Var dest sIf (tvExp num_subhistos .==. 1) unitHistoCase multiHistoCase let h = histoSpaceUsage op - segmented_h = h * product (map (Imp.bytes . toInt64Exp) $ init $ segSpaceDims space) + segmented_h = h * product (map (Imp.bytes . toInt32Exp) $ init $ segSpaceDims space) atomics <- hostAtomics <$> askEnv @@ -163,7 +164,7 @@ SegHistSlug -> CallKernelGen ( Maybe Locking, - [Imp.TExp Int64] -> InKernelGen () + [Imp.TExp Int32] -> InKernelGen () ) prepareAtomicUpdateGlobal l dests slug = -- We need a separate lock array if the operators are not all of a @@ -182,7 +183,7 @@ -- algorithm to ensure good distribution of locks. let num_locks = 100151 dims = - map toInt64Exp $ + map toInt32Exp $ shapeDims (histShape (slugOp slug)) ++ [ tvSize (slugNumSubhistos slug), histWidth (slugOp slug) @@ -207,11 +208,11 @@ prepareIntermediateArraysGlobal :: Passage -> Imp.TExp Int32 -> - Imp.TExp Int64 -> + Imp.TExp Int32 -> [SegHistSlug] -> CallKernelGen ( Imp.TExp Int32, - [[Imp.TExp Int64] -> InKernelGen ()] + [[Imp.TExp Int32] -> InKernelGen ()] ) prepareIntermediateArraysGlobal passage hist_T hist_N slugs = do -- The paper formulae assume there is only one histogram, but in our @@ -222,11 +223,11 @@ -- paper. -- The sum of all Hs. - hist_H <- dPrimVE "hist_H" $ sum $ map (toInt64Exp . histWidth . slugOp) slugs + hist_H <- dPrimVE "hist_H" $ sum $ map (toInt32Exp . histWidth . slugOp) slugs hist_RF <- dPrimVE "hist_RF" $ - sum (map (r64 . toInt64Exp . histRaceFactor . slugOp) slugs) + sum (map (r64 . toInt32Exp . histRaceFactor . slugOp) slugs) / genericLength slugs hist_el_size <- dPrimVE "hist_el_size" $ sum $ map slugElAvgSize slugs @@ -237,7 +238,7 @@ hist_M_min <- dPrimVE "hist_M_min" $ - sMax32 1 $ sExt32 $ t64 $ r64 hist_T / hist_C_max + sMax32 1 $ t64 $ r64 hist_T / hist_C_max -- Querying L2 cache size is not reliable. Instead we provide a -- tunable knob with a hopefully sane default. @@ -267,9 +268,8 @@ $ hist_S <-- case passage of MayBeMultiPass -> - sExt32 $ - (sExt64 hist_M_min * hist_H * sExt64 hist_el_size) - `divUp` t64 (hist_F_L2 * r64 (tvExp hist_L2) * hist_RACE_exp) + (hist_M_min * hist_H * hist_el_size) + `divUp` t64 (hist_F_L2 * r64 (tvExp hist_L2) * hist_RACE_exp) MustBeSinglePass -> 1 @@ -289,7 +289,7 @@ hist_k_RF = 0.75 -- Chosen experimentally hist_F_L2 = 0.4 -- Chosen experimentally r64 = isF64 . ConvOpExp (SIToFP Int32 Float64) . untyped - t64 = isInt64 . ConvOpExp (FPToSI Float64 Int64) . untyped + t64 = isInt32 . ConvOpExp (FPToSI Float64 Int32) . untyped -- "Average element size" as computed by a formula that also takes -- locking into account. @@ -319,9 +319,9 @@ onOp hist_L2 hist_M_min hist_S hist_RACE_exp l slug = do let SegHistSlug op num_subhistos subhisto_info do_op = slug - hist_H = toInt64Exp $ histWidth op + hist_H = toInt32Exp $ histWidth op - hist_H_chk <- dPrimVE "hist_H_chk" $ hist_H `divUp` sExt64 hist_S + hist_H_chk <- dPrimVE "hist_H_chk" $ hist_H `divUp` hist_S emit $ Imp.DebugPrint "Chunk size (H_chk)" $ Just $ untyped hist_H_chk @@ -345,14 +345,14 @@ hist_M <- dPrimVE "hist_M" $ case slugAtomicUpdate slug of AtomicPrim {} -> 1 - _ -> sMax32 hist_M_min $ sExt32 $ t64 $ r64 hist_T / hist_C + _ -> sMax32 hist_M_min $ t64 $ r64 hist_T / hist_C emit $ Imp.DebugPrint "Elements/thread in L2 cache (k_max)" $ Just $ untyped hist_k_max emit $ Imp.DebugPrint "Multiplication degree (M)" $ Just $ untyped hist_M emit $ Imp.DebugPrint "Cooperation level (C)" $ Just $ untyped hist_C -- num_subhistos is the variable we use to communicate back. - num_subhistos <-- sExt64 hist_M + num_subhistos <-- hist_M -- Initialise sub-histograms. -- @@ -384,22 +384,22 @@ histKernelGlobalPass :: [PatElem KernelsMem] -> - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> SegSpace -> [SegHistSlug] -> KernelBody KernelsMem -> - [[Imp.TExp Int64] -> InKernelGen ()] -> + [[Imp.TExp Int32] -> InKernelGen ()] -> Imp.TExp Int32 -> Imp.TExp Int32 -> CallKernelGen () 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 (sExt64 . toInt64Exp) space_sizes + space_sizes_64 = map (sExt64 . toInt32Exp) space_sizes total_w_64 = product space_sizes_64 hist_H_chks <- forM (map (histWidth . slugOp) slugs) $ \w -> - dPrimVE "hist_H_chk" $ toInt64Exp w `divUp` sExt64 hist_S + dPrimVE "hist_H_chk" $ toInt32Exp w `divUp` hist_S sKernelThread "seghist_global" num_groups group_size (segFlat space) $ do constants <- kernelConstants <$> askEnv @@ -408,9 +408,7 @@ subhisto_inds <- forM slugs $ \slug -> dPrimVE "subhisto_ind" $ kernelGlobalThreadId constants - `quot` ( kernelNumThreads constants - `divUp` sExt32 (tvExp (slugNumSubhistos slug)) - ) + `quot` (kernelNumThreads constants `divUp` tvExp (slugNumSubhistos slug)) -- Loop over flat offsets into the input and output. The -- calculation is done with 64-bit integers to avoid overflow, @@ -436,7 +434,7 @@ forM_ (zip map_pes map_res) $ \(pe, res) -> copyDWIMFix (patElemName pe) - (map (Imp.vi64 . fst) $ unSegSpace space) + (map (Imp.vi32 . fst) $ unSegSpace space) (kernelResultSubExp res) [] @@ -452,9 +450,9 @@ subhisto_ind, hist_H_chk ) -> do - let chk_beg = sExt64 chk_i * hist_H_chk - bucket' = toInt64Exp $ kernelResultSubExp bucket - dest_w' = toInt64Exp dest_w + let chk_beg = chk_i * hist_H_chk + bucket' = toInt32Exp $ kernelResultSubExp bucket + dest_w' = toInt32Exp dest_w bucket_in_bounds = chk_beg .<=. bucket' .&&. bucket' .<. (chk_beg + hist_H_chk) @@ -463,8 +461,8 @@ sWhen bucket_in_bounds $ do let bucket_is = - map Imp.vi64 (init space_is) - ++ [sExt64 subhisto_ind, bucket'] + map Imp.vi32 (init space_is) + ++ [subhisto_ind, bucket'] dLParams $ lambdaParams lam sLoopNest shape $ \is -> do forM_ (zip vs_params vs') $ \(p, res) -> @@ -480,10 +478,10 @@ KernelBody KernelsMem -> CallKernelGen () histKernelGlobal map_pes num_groups group_size space slugs kbody = do - let num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size + let num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size let (_space_is, space_sizes) = unzip $ unSegSpace space - num_threads = sExt32 $ unCount num_groups' * unCount group_size' + num_threads = unCount num_groups' * unCount group_size' emit $ Imp.DebugPrint "## Using global memory" Nothing @@ -491,7 +489,7 @@ prepareIntermediateArraysGlobal (bodyPassage kbody) num_threads - (toInt64Exp $ last space_sizes) + (toInt32Exp $ last space_sizes) slugs sFor "chk_i" hist_S $ \chk_i -> @@ -511,25 +509,25 @@ SubExp -> InKernelGen ( [VName], - [Imp.TExp Int64] -> InKernelGen () + [Imp.TExp Int32] -> InKernelGen () ) ) ] prepareIntermediateArraysLocal :: TV Int32 -> - Count NumGroups (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> SegSpace -> [SegHistSlug] -> CallKernelGen InitLocalHistograms prepareIntermediateArraysLocal num_subhistos_per_group groups_per_segment space slugs = do num_segments <- dPrimVE "num_segments" $ - product $ map (toInt64Exp . snd) $ init $ unSegSpace space + product $ map (toInt32Exp . snd) $ init $ unSegSpace space mapM (onOp num_segments) slugs where onOp num_segments (SegHistSlug op num_subhistos subhisto_info do_op) = do - num_subhistos <-- sExt64 (unCount groups_per_segment) * num_segments + num_subhistos <-- unCount groups_per_segment * num_segments emit $ Imp.DebugPrint "Number of subhistograms in global memory" $ @@ -546,7 +544,7 @@ shapeDims (histShape op) ++ [hist_H_chk] - let dims = map toInt64Exp $ shapeDims lock_shape + let dims = map toInt32Exp $ shapeDims lock_shape locks <- sAllocArray "locks" int32 lock_shape $ Space "local" @@ -583,10 +581,10 @@ histKernelLocalPass :: TV Int32 -> - Count NumGroups (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> [PatElem KernelsMem] -> - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> SegSpace -> [SegHistSlug] -> KernelBody KernelsMem -> @@ -611,34 +609,33 @@ segment_dims = init space_sizes (i_in_segment, segment_size) = last $ unSegSpace space num_subhistos_per_group = tvExp num_subhistos_per_group_var - segment_size' = toInt64Exp segment_size + segment_size' = toInt32Exp segment_size num_segments <- dPrimVE "num_segments" $ - product $ map toInt64Exp segment_dims + product $ map toInt32Exp segment_dims hist_H_chks <- forM (map (histWidth . slugOp) slugs) $ \w -> - dPrimV "hist_H_chk" $ toInt64Exp w `divUp` sExt64 hist_S + dPrimV "hist_H_chk" $ toInt32Exp w `divUp` hist_S sKernelThread "seghist_local" num_groups group_size (segFlat space) $ - virtualiseGroups SegVirt (sExt32 $ unCount groups_per_segment * num_segments) $ \group_id -> do + virtualiseGroups SegVirt (unCount groups_per_segment * num_segments) $ \group_id -> do constants <- kernelConstants <$> askEnv - flat_segment_id <- dPrimVE "flat_segment_id" $ group_id `quot` sExt32 (unCount groups_per_segment) - gid_in_segment <- dPrimVE "gid_in_segment" $ group_id `rem` sExt32 (unCount groups_per_segment) + flat_segment_id <- dPrimVE "flat_segment_id" $ group_id `quot` unCount groups_per_segment + gid_in_segment <- dPrimVE "gid_in_segment" $ group_id `rem` unCount groups_per_segment -- This pgtid is kind of a "virtualised physical" gtid - not the -- same thing as the gtid used for the SegHist itself. pgtid_in_segment <- dPrimVE "pgtid_in_segment" $ - gid_in_segment * sExt32 (kernelGroupSize constants) - + kernelLocalThreadId constants + gid_in_segment * kernelGroupSize constants + kernelLocalThreadId constants threads_per_segment <- dPrimVE "threads_per_segment" $ - sExt32 $ unCount groups_per_segment * kernelGroupSize constants + unCount groups_per_segment * kernelGroupSize constants -- Set segment indices. zipWithM_ dPrimV_ segment_is $ - unflattenIndex (map toInt64Exp segment_dims) $ sExt64 flat_segment_id + unflattenIndex (map toInt32Exp segment_dims) flat_segment_id histograms <- forM (zip init_histograms hist_H_chks) $ \((glob_subhistos, init_local_subhistos), hist_H_chk) -> do @@ -655,35 +652,35 @@ let onSlugs f = forM_ (zip slugs histograms) $ \(slug, (dests, hist_H_chk, _)) -> do let histo_dims = tvExp hist_H_chk : - map toInt64Exp (shapeDims (histShape (slugOp slug))) + map toInt32Exp (shapeDims (histShape (slugOp slug))) histo_size <- dPrimVE "histo_size" $ product histo_dims f slug dests (tvExp hist_H_chk) histo_dims histo_size let onAllHistograms f = onSlugs $ \slug dests hist_H_chk histo_dims histo_size -> do - let group_hists_size = num_subhistos_per_group * sExt32 histo_size + let group_hists_size = num_subhistos_per_group * histo_size init_per_thread <- dPrimVE "init_per_thread" $ group_hists_size - `divUp` sExt32 (kernelGroupSize constants) + `divUp` kernelGroupSize constants forM_ (zip dests (histNeutral $ slugOp slug)) $ \((dest_global, dest_local), ne) -> sFor "local_i" init_per_thread $ \i -> do j <- dPrimVE "j" $ - i * sExt32 (kernelGroupSize constants) + i * kernelGroupSize constants + kernelLocalThreadId constants j_offset <- dPrimVE "j_offset" $ - num_subhistos_per_group * sExt32 histo_size * gid_in_segment + j + num_subhistos_per_group * histo_size * gid_in_segment + j - local_subhisto_i <- dPrimVE "local_subhisto_i" $ j `quot` sExt32 histo_size - let local_bucket_is = unflattenIndex histo_dims $ sExt64 $ j `rem` sExt32 histo_size + local_subhisto_i <- dPrimVE "local_subhisto_i" $ j `quot` histo_size + let local_bucket_is = unflattenIndex histo_dims $ j `rem` histo_size global_bucket_is = - head local_bucket_is + sExt64 chk_i * hist_H_chk : + head local_bucket_is + chk_i * hist_H_chk : tail local_bucket_is - global_subhisto_i <- dPrimVE "global_subhisto_i" $ j_offset `quot` sExt32 histo_size + global_subhisto_i <- dPrimVE "global_subhisto_i" $ j_offset `quot` histo_size sWhen (j .<. group_hists_size) $ f @@ -699,8 +696,8 @@ sComment "initialize histograms in local memory" $ onAllHistograms $ \dest_local dest_global op ne local_subhisto_i global_subhisto_i local_bucket_is global_bucket_is -> sComment "First subhistogram is initialised from global memory; others with neutral element." $ do - let global_is = map Imp.vi64 segment_is ++ [0] ++ global_bucket_is - local_is = sExt64 local_subhisto_i : local_bucket_is + let global_is = map Imp.vi32 segment_is ++ [0] ++ global_bucket_is + local_is = local_subhisto_i : local_bucket_is sIf (global_subhisto_i .==. 0) (copyDWIMFix dest_local local_is (Var dest_global) global_is) @@ -710,7 +707,7 @@ sOp $ Imp.Barrier Imp.FenceLocal - kernelLoop pgtid_in_segment threads_per_segment (sExt32 segment_size') $ \ie -> do + kernelLoop pgtid_in_segment threads_per_segment segment_size' $ \ie -> do dPrimV_ i_in_segment ie -- We execute the bucket function once and update each histogram @@ -729,7 +726,7 @@ forM_ (zip map_pes map_res) $ \(pe, se) -> copyDWIMFix (patElemName pe) - (map Imp.vi64 space_is) + (map Imp.vi32 space_is) se [] @@ -739,14 +736,14 @@ bucket, vs' ) -> do - let chk_beg = sExt64 chk_i * tvExp hist_H_chk - bucket' = toInt64Exp bucket - dest_w' = toInt64Exp dest_w + let chk_beg = chk_i * tvExp hist_H_chk + bucket' = toInt32Exp bucket + dest_w' = toInt32Exp dest_w bucket_in_bounds = bucket' .<. dest_w' .&&. chk_beg .<=. bucket' .&&. bucket' .<. (chk_beg + tvExp hist_H_chk) - bucket_is = [sExt64 thread_local_subhisto_i, bucket' - chk_beg] + bucket_is = [thread_local_subhisto_i, bucket' - chk_beg] vs_params = takeLast (length vs') $ lambdaParams lam sComment "perform atomic updates" $ @@ -763,29 +760,27 @@ onSlugs $ \slug dests hist_H_chk histo_dims histo_size -> do bins_per_thread <- dPrimVE "init_per_thread" $ - histo_size `divUp` sExt64 (kernelGroupSize constants) + histo_size `divUp` kernelGroupSize constants trunc_H <- dPrimV "trunc_H" $ - sMin64 hist_H_chk $ - toInt64Exp (histWidth (slugOp slug)) - - sExt64 chk_i * head histo_dims + sMin32 hist_H_chk $ + toInt32Exp (histWidth (slugOp slug)) - chk_i * head histo_dims let trunc_histo_dims = tvExp trunc_H : - map toInt64Exp (shapeDims (histShape (slugOp slug))) + map toInt32Exp (shapeDims (histShape (slugOp slug))) trunc_histo_size <- dPrimVE "histo_size" $ product trunc_histo_dims sFor "local_i" bins_per_thread $ \i -> do j <- dPrimVE "j" $ - i * sExt64 (kernelGroupSize constants) - + sExt64 (kernelLocalThreadId constants) + i * kernelGroupSize constants + kernelLocalThreadId constants sWhen (j .<. trunc_histo_size) $ do -- We are responsible for compacting the flat bin 'j', which -- we immediately unflatten. let local_bucket_is = unflattenIndex histo_dims j global_bucket_is = - head local_bucket_is + sExt64 chk_i * hist_H_chk : + head local_bucket_is + chk_i * hist_H_chk : tail local_bucket_is dLParams $ lambdaParams $ histOp $ slugOp slug let (global_dests, local_dests) = unzip dests @@ -808,20 +803,20 @@ (paramName yp) [] (Var subhisto) - (sExt64 subhisto_id + 1 : local_bucket_is) + (subhisto_id + 1 : local_bucket_is) compileBody' xparams $ lambdaBody $ histOp $ slugOp slug sComment "Put final bucket value in global memory." $ do let global_is = - map Imp.vi64 segment_is - ++ [sExt64 group_id `rem` unCount groups_per_segment] + map Imp.vi32 segment_is + ++ [group_id `rem` unCount groups_per_segment] ++ global_bucket_is forM_ (zip xparams global_dests) $ \(xp, global_dest) -> copyDWIMFix global_dest global_is (Var $ paramName xp) [] histKernelLocal :: TV Int32 -> - Count NumGroups (Imp.TExp Int64) -> + Count NumGroups (Imp.TExp Int32) -> [PatElem KernelsMem] -> Count NumGroups SubExp -> Count GroupSize SubExp -> @@ -831,8 +826,8 @@ KernelBody KernelsMem -> CallKernelGen () histKernelLocal num_subhistos_per_group_var groups_per_segment map_pes num_groups group_size space hist_S slugs kbody = do - let num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size + let num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size num_subhistos_per_group = tvExp num_subhistos_per_group_var emit $ @@ -869,10 +864,10 @@ [PatElem KernelsMem] -> Imp.TExp Int32 -> SegSpace -> - Imp.TExp Int64 -> - Imp.TExp Int64 -> - Imp.TExp Int64 -> Imp.TExp Int32 -> + Imp.TExp Int32 -> + Imp.TExp Int32 -> + Imp.TExp Int32 -> [SegHistSlug] -> KernelBody KernelsMem -> CallKernelGen (Imp.TExp Bool, CallKernelGen ()) @@ -890,20 +885,20 @@ num_groups <- fmap (Imp.Count . tvSize) $ dPrimV "num_groups" $ - hist_T `divUp` sExt32 (toInt64Exp (unCount group_size)) - let num_groups' = toInt64Exp <$> num_groups - group_size' = toInt64Exp <$> group_size + hist_T `divUp` toInt32Exp (unCount group_size) + let num_groups' = toInt32Exp <$> num_groups + group_size' = toInt32Exp <$> group_size - let r64 = isF64 . ConvOpExp (SIToFP Int64 Float64) . untyped - t64 = isInt64 . ConvOpExp (FPToSI Float64 Int64) . untyped + let r64 = isF64 . ConvOpExp (SIToFP Int32 Float64) . untyped + t64 = isInt32 . ConvOpExp (FPToSI Float64 Int32) . untyped -- M approximation. hist_m' <- dPrimVE "hist_m_prime" $ r64 - ( sMin64 - (sExt64 (tvExp hist_L `quot` hist_el_size)) - (hist_N `divUp` sExt64 (unCount num_groups')) + ( sMin32 + (tvExp hist_L `quot` hist_el_size) + (hist_N `divUp` unCount num_groups') ) / r64 hist_H @@ -912,15 +907,15 @@ -- M in the paper, but not adjusted for asymptotic efficiency. hist_M0 <- dPrimVE "hist_M0" $ - sMax64 1 $ sMin64 (t64 hist_m') hist_B + sMax32 1 $ sMin32 (t64 hist_m') hist_B -- Minimal sequential chunking factor. let q_small = 2 -- The number of segments/histograms produced.. - hist_Nout <- dPrimVE "hist_Nout" $ product $ map toInt64Exp segment_dims + hist_Nout <- dPrimVE "hist_Nout" $ product $ map toInt32Exp segment_dims - hist_Nin <- dPrimVE "hist_Nin" $ toInt64Exp $ last space_sizes + hist_Nin <- dPrimVE "hist_Nin" $ toInt32Exp $ last space_sizes -- Maximum M for work efficiency. work_asymp_M_max <- @@ -933,9 +928,9 @@ `divUp` sExt64 hist_Nout -- Number of groups, rounded up. - let r = hist_T_hist_min `divUp` sExt32 hist_B + let r = hist_T_hist_min `divUp` hist_B - dPrimVE "work_asymp_M_max" $ hist_Nin `quot` (sExt64 r * hist_H) + dPrimVE "work_asymp_M_max" $ hist_Nin `quot` (r * hist_H) else dPrimVE "work_asymp_M_max" $ (hist_Nout * hist_N) @@ -944,7 +939,7 @@ ) -- Number of subhistograms per result histogram. - hist_M <- dPrimV "hist_M" $ sExt32 $ sMin64 hist_M0 work_asymp_M_max + hist_M <- dPrimV "hist_M" $ sMin32 hist_M0 work_asymp_M_max -- hist_M may be zero (which we'll check for below), but we need it -- for some divisions first, so crudely make a nonzero form. @@ -954,7 +949,7 @@ -- working on the same (sub)histogram. hist_C <- dPrimVE "hist_C" $ - hist_B `divUp` sExt64 hist_M_nonzero + hist_B `divUp` hist_M_nonzero emit $ Imp.DebugPrint "local hist_M0" $ Just $ untyped hist_M0 emit $ Imp.DebugPrint "local work asymp M max" $ Just $ untyped work_asymp_M_max @@ -963,19 +958,14 @@ emit $ Imp.DebugPrint "local M" $ Just $ untyped $ tvExp hist_M emit $ Imp.DebugPrint "local memory needed" $ - Just $ untyped $ hist_H * hist_el_size * sExt64 (tvExp hist_M) + Just $ untyped $ hist_H * hist_el_size * tvExp hist_M -- local_mem_needed is what we need to keep a single bucket in local -- memory - this is an absolute minimum. We can fit anything else -- by doing multiple passes, although more than a few is -- (heuristically) not efficient. - local_mem_needed <- - dPrimVE "local_mem_needed" $ - hist_el_size * sExt64 (tvExp hist_M) - hist_S <- - dPrimVE "hist_S" $ - sExt32 $ - (hist_H * local_mem_needed) `divUp` tvExp hist_L + local_mem_needed <- dPrimVE "local_mem_needed" $ hist_el_size * tvExp hist_M + hist_S <- dPrimVE "hist_S" $ (hist_H * local_mem_needed) `divUp` tvExp hist_L let max_S = case bodyPassage kbody of MustBeSinglePass -> 1 MayBeMultiPass -> fromIntegral $ maxinum $ map slugMaxLocalMemPasses slugs @@ -1030,9 +1020,9 @@ -- rather figuring out whether to use a local or global memory -- strategy, as well as collapsing the subhistograms produced (which -- are always in global memory, but their number may vary). - let num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size - dims = map toInt64Exp $ segSpaceDims space + let num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size + dims = map toInt32Exp $ segSpaceDims space num_red_res = length ops + sum (map (length . histNeutral) ops) (all_red_pes, map_pes) = splitAt num_red_res pes @@ -1048,7 +1038,7 @@ let hist_B = unCount group_size' -- Size of a histogram. - hist_H <- dPrimVE "hist_H" $ sum $ map (toInt64Exp . histWidth) ops + hist_H <- dPrimVE "hist_H" $ sum $ map (toInt32Exp . histWidth) ops -- Size of a single histogram element. Actually the weighted -- average of histogram elements in cases where we have more than @@ -1070,7 +1060,7 @@ sum (map (toInt32Exp . histRaceFactor . slugOp) slugs) `quot` genericLength slugs - let hist_T = sExt32 $ unCount num_groups' * unCount group_size' + let hist_T = unCount num_groups' * unCount group_size' emit $ Imp.DebugPrint "\n# SegHist" Nothing emit $ Imp.DebugPrint "Number of threads (T)" $ Just $ untyped hist_T emit $ Imp.DebugPrint "Desired group size (B)" $ Just $ untyped hist_B @@ -1078,7 +1068,7 @@ emit $ Imp.DebugPrint "Input elements per histogram (N)" $ Just $ untyped hist_N emit $ Imp.DebugPrint "Number of segments" $ - Just $ untyped $ product $ map (toInt64Exp . snd) segment_dims + Just $ untyped $ product $ map (toInt32Exp . snd) segment_dims emit $ Imp.DebugPrint "Histogram element size (el_size)" $ Just $ untyped hist_el_size emit $ Imp.DebugPrint "Race factor (RF)" $ Just $ untyped hist_RF emit $ Imp.DebugPrint "Memory per set of subhistograms per segment" $ Just $ untyped h @@ -1136,7 +1126,7 @@ red_cont $ flip map subhistos $ \subhisto -> ( Var subhisto, - map Imp.vi64 $ + map Imp.vi32 $ map fst segment_dims ++ [subhistogram_id, bucket_id] ++ vector_ids ) where diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegMap.hs @@ -24,15 +24,14 @@ CallKernelGen () compileSegMap pat lvl space kbody = do let (is, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims - num_groups' = toInt64Exp <$> segNumGroups lvl - group_size' = toInt64Exp <$> segGroupSize lvl + dims' = map toInt32Exp dims + num_groups' = toInt32Exp <$> segNumGroups lvl + group_size' = toInt32Exp <$> segGroupSize lvl case lvl of SegThread {} -> do emit $ Imp.DebugPrint "\n# SegMap" Nothing - let virt_num_groups = - sExt32 $ product dims' `divUp` unCount group_size' + let virt_num_groups = product dims' `divUp` unCount group_size' sKernelThread "segmap" num_groups' group_size' (segFlat space) $ virtualiseGroups (segVirt lvl) virt_num_groups $ \group_id -> do local_tid <- kernelLocalThreadId . kernelConstants <$> askEnv @@ -41,7 +40,7 @@ + sExt64 local_tid zipWithM_ dPrimV_ is $ - map sExt64 $ unflattenIndex (map sExt64 dims') global_tid + map sExt32 $ unflattenIndex (map sExt64 dims') global_tid sWhen (isActive $ unSegSpace space) $ compileStms mempty (kernelBodyStms kbody) $ @@ -49,10 +48,10 @@ kernelBodyResult kbody SegGroup {} -> sKernelGroup "segmap_intragroup" num_groups' group_size' (segFlat space) $ do - let virt_num_groups = sExt32 $ product dims' + let virt_num_groups = product dims' precomputeSegOpIDs (kernelBodyStms kbody) $ virtualiseGroups (segVirt lvl) virt_num_groups $ \group_id -> do - zipWithM_ dPrimV_ is $ unflattenIndex dims' $ sExt64 group_id + zipWithM_ dPrimV_ is $ unflattenIndex dims' group_id compileStms mempty (kernelBodyStms kbody) $ zipWithM_ (compileGroupResult space) (patternElements pat) $ diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegRed.hs @@ -72,7 +72,7 @@ -- for saving the results of the body. The results should be -- represented as a pairing of a t'SubExp' along with a list of -- indexes into that 'SubExp' for reading the result. -type DoSegBody = ([(SubExp, [Imp.TExp Int64])] -> InKernelGen ()) -> InKernelGen () +type DoSegBody = ([(SubExp, [Imp.TExp Int32])] -> InKernelGen ()) -> InKernelGen () -- | Compile 'SegRed' instance to host-level code with calls to -- various kernels. @@ -106,7 +106,7 @@ | genericLength reds > maxNumOps = compilerLimitationS $ "compileSegRed': at most " ++ show maxNumOps ++ " reduction operators are supported." - | [(_, Constant (IntValue (Int64Value 1))), _] <- unSegSpace space = + | [(_, Constant (IntValue (Int32Value 1))), _] <- unSegSpace space = nonsegmentedReduction pat num_groups group_size space reds body | otherwise = do let group_size' = toInt32Exp $ unCount group_size @@ -139,7 +139,7 @@ MemArray pt shape _ (ArrayIn mem _) -> do let shape' = Shape [num_threads] <> shape sArray "red_arr" pt shape' $ - ArrayIn mem $ IxFun.iota $ map pe64 $ shapeDims shape' + ArrayIn mem $ IxFun.iota $ map pe32 $ shapeDims shape' _ -> do let pt = elemType $ paramType p shape = Shape [group_size] @@ -176,9 +176,9 @@ CallKernelGen () nonsegmentedReduction segred_pat num_groups group_size space reds body = do let (gtids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims - num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size + dims' = map toInt32Exp dims + num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size global_tid = Imp.vi32 $ segFlat space w = last dims' @@ -204,9 +204,7 @@ forM_ gtids $ \v -> dPrimV_ v (0 :: Imp.TExp Int32) let num_elements = Imp.elements w - elems_per_thread = - num_elements - `divUp` Imp.elements (sExt64 (kernelNumThreads constants)) + let elems_per_thread = num_elements `divUp` Imp.elements (kernelNumThreads constants) slugs <- mapM @@ -255,7 +253,7 @@ 0 [0] 0 - (sExt64 $ kernelNumGroups constants) + (kernelNumGroups constants) slug red_x_params red_y_params @@ -278,19 +276,19 @@ CallKernelGen () smallSegmentsReduction (Pattern _ segred_pes) num_groups group_size space reds body = do let (gtids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims segment_size = last dims' -- Careful to avoid division by zero now. segment_size_nonzero <- - dPrimVE "segment_size_nonzero" $ sMax64 1 segment_size + dPrimVE "segment_size_nonzero" $ sMax32 1 segment_size - let num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size + let num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size num_threads <- dPrimV "num_threads" $ unCount num_groups' * unCount group_size' let num_segments = product $ init dims' segments_per_group = unCount group_size' `quot` segment_size_nonzero - required_groups = sExt32 $ num_segments `divUp` segments_per_group + required_groups = num_segments `divUp` segments_per_group emit $ Imp.DebugPrint "\n# SegRed-small" Nothing emit $ Imp.DebugPrint "num_segments" $ Just $ untyped num_segments @@ -309,10 +307,8 @@ -- Compute the 'n' input indices. The outer 'n-1' correspond to -- the segment ID, and are computed from the group id. The inner -- is computed from the local thread id, and may be out-of-bounds. - let ltid = sExt64 $ kernelLocalThreadId constants - segment_index = - (ltid `quot` segment_size_nonzero) - + (sExt64 group_id' * sExt64 segments_per_group) + let ltid = kernelLocalThreadId constants + segment_index = (ltid `quot` segment_size_nonzero) + (group_id' * segments_per_group) index_within_segment = ltid `rem` segment_size zipWithM_ dPrimV_ (init gtids) $ unflattenIndex (init dims') segment_index @@ -340,14 +336,13 @@ out_of_bounds sOp $ Imp.ErrorSync Imp.FenceLocal -- Also implicitly barrier. - let crossesSegment from to = - (sExt64 to - sExt64 from) .>. (sExt64 to `rem` segment_size) + let crossesSegment from to = (to - from) .>. (to `rem` segment_size) sWhen (segment_size .>. 0) $ sComment "perform segmented scan to imitate reduction" $ forM_ (zip reds reds_arrs) $ \(SegBinOp _ red_op _ _, red_arrs) -> groupScan (Just crossesSegment) - (sExt64 $ tvExp num_threads) + (tvExp num_threads) (segment_size * segments_per_group) red_op red_arrs @@ -356,15 +351,13 @@ sComment "save final values of segments" $ sWhen - ( sExt64 group_id' * segments_per_group + sExt64 ltid .<. num_segments + ( group_id' * segments_per_group + ltid .<. num_segments .&&. ltid .<. segments_per_group ) $ forM_ (zip segred_pes (concat reds_arrs)) $ \(pe, arr) -> do -- Figure out which segment result this thread should write... - let flat_segment_index = - sExt64 group_id' * segments_per_group + sExt64 ltid - gtids' = - unflattenIndex (init dims') flat_segment_index + let flat_segment_index = group_id' * segments_per_group + ltid + gtids' = unflattenIndex (init dims') flat_segment_index copyDWIMFix (patElemName pe) gtids' @@ -385,11 +378,11 @@ CallKernelGen () largeSegmentsReduction segred_pat num_groups group_size space reds body = do let (gtids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims num_segments = product $ init dims' segment_size = last dims' - num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size + num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size (groups_per_segment, elems_per_thread) <- groupsPerSegmentAndElementsPerThread @@ -443,26 +436,26 @@ -- We probably do not have enough actual workgroups to cover the -- entire iteration space. Some groups thus have to perform double -- duty; we put an outer loop to accomplish this. - virtualiseGroups SegVirt (sExt32 (tvExp virt_num_groups)) $ \group_id -> do + virtualiseGroups SegVirt (tvExp virt_num_groups) $ \group_id -> do let segment_gtids = init gtids w = last dims local_tid = kernelLocalThreadId constants flat_segment_id <- dPrimVE "flat_segment_id" $ - group_id `quot` sExt32 groups_per_segment + group_id `quot` groups_per_segment global_tid <- dPrimVE "global_tid" $ - (sExt64 group_id * sExt64 (unCount group_size') + sExt64 local_tid) - `rem` (sExt64 (unCount group_size') * groups_per_segment) + (group_id * unCount group_size' + local_tid) + `rem` (unCount group_size' * groups_per_segment) - let first_group_for_segment = sExt64 flat_segment_id * groups_per_segment + let first_group_for_segment = flat_segment_id * groups_per_segment zipWithM_ dPrimV_ segment_gtids $ - unflattenIndex (init dims') $ sExt64 flat_segment_id - dPrim_ (last gtids) int64 - let num_elements = Imp.elements $ toInt64Exp w + unflattenIndex (init dims') flat_segment_id + dPrim_ (last gtids) int32 + let num_elements = Imp.elements $ toInt32Exp w slugs <- mapM (segBinOpSlug local_tid group_id) $ @@ -472,7 +465,7 @@ constants (zip gtids dims') num_elements - (sExt32 global_tid) + global_tid elems_per_thread (tvVar threads_per_segment) slugs @@ -508,8 +501,8 @@ pes group_id flat_segment_id - (map Imp.vi64 segment_gtids) - (sExt64 first_group_for_segment) + (map Imp.vi32 segment_gtids) + first_group_for_segment groups_per_segment slug red_x_params @@ -528,25 +521,25 @@ forM_ (zip slugs segred_pes) $ \(slug, pes) -> sWhen (local_tid .==. 0) $ forM_ (zip pes (slugAccs slug)) $ \(v, (acc, acc_is)) -> - copyDWIMFix (patElemName v) (map Imp.vi64 segment_gtids) (Var acc) acc_is + copyDWIMFix (patElemName v) (map Imp.vi32 segment_gtids) (Var acc) acc_is sIf (groups_per_segment .==. 1) one_group_per_segment multiple_groups_per_segment -- Careful to avoid division by zero here. We have at least one group -- per segment. groupsPerSegmentAndElementsPerThread :: - Imp.TExp Int64 -> - Imp.TExp Int64 -> - Count NumGroups (Imp.TExp Int64) -> - Count GroupSize (Imp.TExp Int64) -> + Imp.TExp Int32 -> + Imp.TExp Int32 -> + Count NumGroups (Imp.TExp Int32) -> + Count GroupSize (Imp.TExp Int32) -> CallKernelGen - ( Imp.TExp Int64, - Imp.Count Imp.Elements (Imp.TExp Int64) + ( Imp.TExp Int32, + Imp.Count Imp.Elements (Imp.TExp Int32) ) groupsPerSegmentAndElementsPerThread segment_size num_segments num_groups_hint group_size = do groups_per_segment <- dPrimVE "groups_per_segment" $ - unCount num_groups_hint `divUp` sMax64 1 num_segments + unCount num_groups_hint `divUp` sMax32 1 num_segments elements_per_thread <- dPrimVE "elements_per_thread" $ segment_size `divUp` (unCount group_size * groups_per_segment) @@ -559,7 +552,7 @@ -- (either local or global memory). slugArrs :: [VName], -- | Places to store accumulator in stage 1 reduction. - slugAccs :: [(VName, [Imp.TExp Int64])] + slugAccs :: [(VName, [Imp.TExp Int32])] } slugBody :: SegBinOpSlug -> Body KernelsMem @@ -592,29 +585,29 @@ acc <- dPrim (baseString (paramName p) <> "_acc") t return (tvVar acc, []) | otherwise = - return (param_arr, [sExt64 local_tid, sExt64 group_id]) + return (param_arr, [local_tid, group_id]) reductionStageZero :: KernelConstants -> - [(VName, Imp.TExp Int64)] -> - Imp.Count Imp.Elements (Imp.TExp Int64) -> + [(VName, Imp.TExp Int32)] -> + Imp.Count Imp.Elements (Imp.TExp Int32) -> Imp.TExp Int32 -> - Imp.Count Imp.Elements (Imp.TExp Int64) -> + Imp.Count Imp.Elements (Imp.TExp Int32) -> VName -> [SegBinOpSlug] -> DoSegBody -> InKernelGen ([Lambda KernelsMem], InKernelGen ()) reductionStageZero constants ispace num_elements global_tid elems_per_thread threads_per_segment slugs body = do let (gtids, _dims) = unzip ispace - gtid = mkTV (last gtids) int64 - local_tid = sExt64 $ kernelLocalThreadId constants + gtid = mkTV (last gtids) int32 + local_tid = kernelLocalThreadId constants -- Figure out how many elements this thread should process. - chunk_size <- dPrim "chunk_size" int64 + chunk_size <- dPrim "chunk_size" int32 let ordering = case slugsComm slugs of Commutative -> SplitStrided $ Var threads_per_segment Noncommutative -> SplitContiguous - computeThreadChunkSize ordering (sExt64 global_tid) elems_per_thread num_elements chunk_size + computeThreadChunkSize ordering global_tid elems_per_thread num_elements chunk_size dScope Nothing $ scopeOfLParams $ concatMap slugParams slugs @@ -638,7 +631,7 @@ copyDWIMFix arr [local_tid] (Var $ paramName p) [] sOp $ Imp.ErrorSync Imp.FenceLocal -- Also implicitly barrier. - groupReduce (sExt32 (kernelGroupSize constants)) slug_op_renamed (slugArrs slug) + groupReduce (kernelGroupSize constants) slug_op_renamed (slugArrs slug) sOp $ Imp.Barrier Imp.FenceLocal @@ -663,13 +656,13 @@ gtid <-- case comm of Commutative -> - sExt64 global_tid - + Imp.vi64 threads_per_segment * i + global_tid + + Imp.vi32 threads_per_segment * i Noncommutative -> - let index_in_segment = global_tid `quot` sExt32 (kernelGroupSize constants) - in sExt64 local_tid - + (sExt64 index_in_segment * Imp.unCount elems_per_thread + i) - * sExt64 (kernelGroupSize constants) + let index_in_segment = global_tid `quot` kernelGroupSize constants + in local_tid + + (index_in_segment * Imp.unCount elems_per_thread + i) + * kernelGroupSize constants check_bounds $ sComment "apply map function" $ @@ -711,10 +704,10 @@ reductionStageOne :: KernelConstants -> - [(VName, Imp.TExp Int64)] -> - Imp.Count Imp.Elements (Imp.TExp Int64) -> + [(VName, Imp.TExp Int32)] -> + Imp.Count Imp.Elements (Imp.TExp Int32) -> Imp.TExp Int32 -> - Imp.Count Imp.Elements (Imp.TExp Int64) -> + Imp.Count Imp.Elements (Imp.TExp Int32) -> VName -> [SegBinOpSlug] -> DoSegBody -> @@ -737,9 +730,9 @@ [PatElem KernelsMem] -> Imp.TExp Int32 -> Imp.TExp Int32 -> - [Imp.TExp Int64] -> - Imp.TExp Int64 -> - Imp.TExp Int64 -> + [Imp.TExp Int32] -> + Imp.TExp Int32 -> + Imp.TExp Int32 -> SegBinOpSlug -> [LParam KernelsMem] -> [LParam KernelsMem] -> @@ -777,14 +770,13 @@ (counter_mem, _, counter_offset) <- fullyIndexArray counter - [ sExt64 $ - counter_i * num_counters - + flat_segment_id `rem` num_counters + [ counter_i * num_counters + + flat_segment_id `rem` num_counters ] comment "first thread in group saves group result to global memory" $ sWhen (local_tid .==. 0) $ do forM_ (take (length nes) $ zip group_res_arrs (slugAccs slug)) $ \(v, (acc, acc_is)) -> - copyDWIMFix v [0, sExt64 group_id] (Var acc) acc_is + copyDWIMFix v [0, group_id] (Var acc) acc_is sOp $ Imp.MemFence Imp.FenceGlobal -- Increment the counter, thus stating that our result is -- available. @@ -794,7 +786,7 @@ Int32 (tvVar old_counter) counter_mem - counter_offset + (sExt32 <$> counter_offset) $ untyped (1 :: Imp.TExp Int32) -- Now check if we were the last group to write our result. If -- so, it is our responsibility to produce the final result. @@ -814,7 +806,7 @@ sWhen (local_tid .==. 0) $ sOp $ Imp.Atomic DefaultSpace $ - Imp.AtomicAdd Int32 (tvVar old_counter) counter_mem counter_offset $ + Imp.AtomicAdd Int32 (tvVar old_counter) counter_mem (sExt32 <$> counter_offset) $ untyped $ negate groups_per_segment sLoopNest (slugShape slug) $ \vec_is -> do @@ -826,7 +818,7 @@ comment "read in the per-group-results" $ do read_per_thread <- dPrimVE "read_per_thread" $ - groups_per_segment `divUp` sExt64 group_size + groups_per_segment `divUp` group_size forM_ (zip red_x_params nes) $ \(p, ne) -> copyDWIMFix (paramName p) [] ne [] @@ -834,7 +826,7 @@ sFor "i" read_per_thread $ \i -> do group_res_id <- dPrimVE "group_res_id" $ - sExt64 local_tid * read_per_thread + i + local_tid * read_per_thread + i index_of_group_res <- dPrimVE "index_of_group_res" $ first_group_for_segment + group_res_id @@ -854,12 +846,12 @@ forM_ (zip red_x_params red_arrs) $ \(p, arr) -> when (primType $ paramType p) $ - copyDWIMFix arr [sExt64 local_tid] (Var $ paramName p) [] + copyDWIMFix arr [local_tid] (Var $ paramName p) [] sOp $ Imp.Barrier Imp.FenceLocal sComment "reduce the per-group results" $ do - groupReduce (sExt32 group_size) red_op_renamed red_arrs + groupReduce group_size red_op_renamed red_arrs sComment "and back to memory with the final result" $ sWhen (local_tid .==. 0) $ diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs b/src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels/SegScan.hs @@ -44,7 +44,7 @@ arr <- lift $ sArray "scan_arr" pt shape' $ - ArrayIn mem $ IxFun.iota $ map pe64 $ shapeDims shape' + ArrayIn mem $ IxFun.iota $ map pe32 $ shapeDims shape' return (arr, []) _ -> do let pt = elemType $ paramType p @@ -69,13 +69,13 @@ mem <- lift $ sDeclareMem "scan_arr_mem" $ Space "local" return ([size], mem) -type CrossesSegment = Maybe (Imp.TExp Int64 -> Imp.TExp Int64 -> Imp.TExp Bool) +type CrossesSegment = Maybe (Imp.TExp Int32 -> Imp.TExp Int32 -> Imp.TExp Bool) -localArrayIndex :: KernelConstants -> Type -> Imp.TExp Int64 +localArrayIndex :: KernelConstants -> Type -> Imp.TExp Int32 localArrayIndex constants t = if primType t - then sExt64 (kernelLocalThreadId constants) - else sExt64 (kernelGlobalThreadId constants) + then kernelLocalThreadId constants + else kernelGlobalThreadId constants barrierFor :: Lambda KernelsMem -> (Bool, Imp.Fence, InKernelGen ()) barrierFor scan_op = (array_scan, fence, sOp $ Imp.Barrier fence) @@ -100,7 +100,7 @@ forM_ (zip pes scan_res) $ \(pe, res) -> copyDWIMFix (patElemName pe) - (map Imp.vi64 gtids) + (map Imp.vi32 gtids) (kernelResultSubExp res) [] | otherwise = @@ -108,7 +108,7 @@ copyDWIMFix (paramName p) [] (kernelResultSubExp res) [] readToScanValues :: - [Imp.TExp Int64] -> + [Imp.TExp Int32] -> [PatElem KernelsMem] -> SegBinOp KernelsMem -> InKernelGen () @@ -120,9 +120,9 @@ return () readCarries :: - Imp.TExp Int64 -> - [Imp.TExp Int64] -> - [Imp.TExp Int64] -> + Imp.TExp Int32 -> + [Imp.TExp Int32] -> + [Imp.TExp Int32] -> [PatElem KernelsMem] -> SegBinOp KernelsMem -> InKernelGen () @@ -152,16 +152,16 @@ SegSpace -> [SegBinOp KernelsMem] -> KernelBody KernelsMem -> - CallKernelGen (TV Int32, Imp.TExp Int64, CrossesSegment) + CallKernelGen (TV Int32, Imp.TExp Int32, CrossesSegment) scanStage1 (Pattern _ all_pes) num_groups group_size space scans kbody = do - let num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size - num_threads <- dPrimV "num_threads" $ sExt32 $ unCount num_groups' * unCount group_size' + let num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size + num_threads <- dPrimV "num_threads" $ unCount num_groups' * unCount group_size' let (gtids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims let num_elements = product dims' - elems_per_thread = num_elements `divUp` sExt64 (tvExp num_threads) + elems_per_thread = num_elements `divUp` tvExp num_threads elems_per_group = unCount group_size' * elems_per_thread let crossesSegment = @@ -184,18 +184,18 @@ sFor "j" elems_per_thread $ \j -> do chunk_offset <- dPrimV "chunk_offset" $ - sExt64 (kernelGroupSize constants) * j - + sExt64 (kernelGroupId constants) * elems_per_group + kernelGroupSize constants * j + + kernelGroupId constants * elems_per_group flat_idx <- dPrimV "flat_idx" $ - tvExp chunk_offset + sExt64 (kernelLocalThreadId constants) + tvExp chunk_offset + kernelLocalThreadId constants -- Construct segment indices. zipWithM_ dPrimV_ gtids $ unflattenIndex dims' $ tvExp flat_idx let per_scan_pes = segBinOpChunks scans all_pes in_bounds = - foldl1 (.&&.) $ zipWith (.<.) (map Imp.vi64 gtids) dims' + foldl1 (.&&.) $ zipWith (.<.) (map Imp.vi32 gtids) dims' when_in_bounds = compileStms mempty (kernelBodyStms kbody) $ do let (all_scan_res, map_res) = @@ -211,7 +211,7 @@ forM_ (zip (takeLast (length map_res) all_pes) map_res) $ \(pe, se) -> copyDWIMFix (patElemName pe) - (map Imp.vi64 gtids) + (map Imp.vi32 gtids) (kernelResultSubExp se) [] @@ -232,7 +232,7 @@ sIf in_bounds ( do - readToScanValues (map Imp.vi64 gtids ++ vec_is) pes scan + readToScanValues (map Imp.vi32 gtids ++ vec_is) pes scan readCarries (tvExp chunk_offset) dims' vec_is pes scan ) ( forM_ (zip (yParams scan) (segBinOpNeutral scan)) $ \(p, ne) -> @@ -242,14 +242,13 @@ sComment "combine with carry and write to local memory" $ compileStms mempty (bodyStms $ lambdaBody scan_op) $ forM_ (zip3 rets local_arrs (bodyResult $ lambdaBody scan_op)) $ - \(t, arr, se) -> - copyDWIMFix arr [localArrayIndex constants t] se [] + \(t, arr, se) -> copyDWIMFix arr [localArrayIndex constants t] se [] let crossesSegment' = do f <- crossesSegment Just $ \from to -> - let from' = sExt64 from + tvExp chunk_offset - to' = sExt64 to + tvExp chunk_offset + let from' = from + tvExp chunk_offset + to' = to + tvExp chunk_offset in f from' to' sOp $ Imp.ErrorSync fence @@ -258,8 +257,8 @@ scan_op_renamed <- renameLambda scan_op groupScan crossesSegment' - (sExt64 $ tvExp num_threads) - (sExt64 $ kernelGroupSize constants) + (tvExp num_threads) + (kernelGroupSize constants) scan_op_renamed local_arrs @@ -268,7 +267,7 @@ forM_ (zip3 rets pes local_arrs) $ \(t, pe, arr) -> copyDWIMFix (patElemName pe) - (map Imp.vi64 gtids ++ vec_is) + (map Imp.vi32 gtids ++ vec_is) (Var arr) [localArrayIndex constants t] @@ -281,10 +280,8 @@ [] (Var arr) [ if primType $ paramType p - then sExt64 (kernelGroupSize constants) - 1 - else - (sExt64 (kernelGroupId constants) + 1) - * sExt64 (kernelGroupSize constants) - 1 + then kernelGroupSize constants - 1 + else (kernelGroupId constants + 1) * kernelGroupSize constants - 1 ] load_neutral = forM_ (zip nes scan_x_params) $ \(ne, p) -> @@ -297,10 +294,10 @@ Just f -> f ( tvExp chunk_offset - + sExt64 (kernelGroupSize constants) -1 + + kernelGroupSize constants -1 ) ( tvExp chunk_offset - + sExt64 (kernelGroupSize constants) + + kernelGroupSize constants ) should_load_carry <- dPrimVE "should_load_carry" $ @@ -316,7 +313,7 @@ scanStage2 :: Pattern KernelsMem -> TV Int32 -> - Imp.TExp Int64 -> + Imp.TExp Int32 -> Count NumGroups SubExp -> CrossesSegment -> SegSpace -> @@ -324,18 +321,16 @@ CallKernelGen () scanStage2 (Pattern _ all_pes) stage1_num_threads elems_per_group num_groups crossesSegment space scans = do let (gtids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims -- Our group size is the number of groups for the stage 1 kernel. let group_size = Count $ unCount num_groups - group_size' = fmap toInt64Exp group_size + group_size' = fmap toInt32Exp group_size let crossesSegment' = do f <- crossesSegment Just $ \from to -> - f - ((sExt64 from + 1) * elems_per_group - 1) - ((sExt64 to + 1) * elems_per_group - 1) + f ((from + 1) * elems_per_group - 1) ((to + 1) * elems_per_group - 1) sKernelThread "scan_stage2" 1 group_size' (segFlat space) $ do constants <- kernelConstants <$> askEnv @@ -345,17 +340,17 @@ flat_idx <- dPrimV "flat_idx" $ - (sExt64 (kernelLocalThreadId constants) + 1) * elems_per_group - 1 + (kernelLocalThreadId constants + 1) * elems_per_group - 1 -- Construct segment indices. zipWithM_ dPrimV_ gtids $ unflattenIndex dims' $ tvExp flat_idx forM_ (zip4 scans per_scan_local_arrs per_scan_rets per_scan_pes) $ \(SegBinOp _ scan_op nes vec_shape, local_arrs, rets, pes) -> sLoopNest vec_shape $ \vec_is -> do - let glob_is = map Imp.vi64 gtids ++ vec_is + let glob_is = map Imp.vi32 gtids ++ vec_is in_bounds = - foldl1 (.&&.) $ zipWith (.<.) (map Imp.vi64 gtids) dims' + foldl1 (.&&.) $ zipWith (.<.) (map Imp.vi32 gtids) dims' when_in_bounds = forM_ (zip3 rets local_arrs pes) $ \(t, arr, pe) -> copyDWIMFix @@ -376,8 +371,8 @@ groupScan crossesSegment' - (sExt64 $ tvExp stage1_num_threads) - (sExt64 $ kernelGroupSize constants) + (tvExp stage1_num_threads) + (kernelGroupSize constants) scan_op local_arrs @@ -394,19 +389,19 @@ Pattern KernelsMem -> Count NumGroups SubExp -> Count GroupSize SubExp -> - Imp.TExp Int64 -> + Imp.TExp Int32 -> CrossesSegment -> SegSpace -> [SegBinOp KernelsMem] -> CallKernelGen () scanStage3 (Pattern _ all_pes) num_groups group_size elems_per_group crossesSegment space scans = do - let num_groups' = fmap toInt64Exp num_groups - group_size' = fmap toInt64Exp group_size + let num_groups' = fmap toInt32Exp num_groups + group_size' = fmap toInt32Exp group_size (gtids, dims) = unzip $ unSegSpace space - dims' = map toInt64Exp dims + dims' = map toInt32Exp dims required_groups <- dPrimVE "required_groups" $ - sExt32 $ product dims' `divUp` sExt64 (unCount group_size') + product dims' `divUp` unCount group_size' sKernelThread "scan_stage3" num_groups' group_size' (segFlat space) $ virtualiseGroups SegVirt required_groups $ \virt_group_id -> do @@ -415,8 +410,8 @@ -- Compute our logical index. flat_idx <- dPrimVE "flat_idx" $ - sExt64 virt_group_id * sExt64 (unCount group_size') - + sExt64 (kernelLocalThreadId constants) + virt_group_id * unCount group_size' + + kernelLocalThreadId constants zipWithM_ dPrimV_ gtids $ unflattenIndex dims' flat_idx -- Figure out which group this element was originally in. @@ -433,7 +428,7 @@ -- then the carry was updated in stage 2), and we are not crossing -- a segment boundary. let in_bounds = - foldl1 (.&&.) $ zipWith (.<.) (map Imp.vi64 gtids) dims' + foldl1 (.&&.) $ zipWith (.<.) (map Imp.vi32 gtids) dims' crosses_segment = fromMaybe false $ crossesSegment @@ -464,14 +459,14 @@ (paramName p) [] (Var $ patElemName pe) - (map Imp.vi64 gtids ++ vec_is) + (map Imp.vi32 gtids ++ vec_is) compileBody' scan_x_params $ lambdaBody scan_op forM_ (zip scan_x_params pes) $ \(p, pe) -> copyDWIMFix (patElemName pe) - (map Imp.vi64 gtids ++ vec_is) + (map Imp.vi32 gtids ++ vec_is) (Var $ paramName p) [] diff --git a/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs b/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs --- a/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs +++ b/src/Futhark/CodeGen/ImpGen/Kernels/ToOpenCL.hs @@ -180,7 +180,7 @@ let params = [ [C.cparam|__global int *global_failure|], - [C.cparam|__global typename int64_t *global_failure_args|] + [C.cparam|__global int *global_failure_args|] ] (func, cstate) = genGPUCode FunMode (functionBody device_func) failures $ @@ -312,7 +312,7 @@ failure_params = [ [C.cparam|__global int *global_failure|], [C.cparam|int failure_is_an_option|], - [C.cparam|__global typename int64_t *global_failure_args|] + [C.cparam|__global int *global_failure_args|] ] params = @@ -780,10 +780,6 @@ let setArgs _ [] = return [] setArgs i (ErrorString {} : parts') = setArgs i parts' setArgs i (ErrorInt32 x : parts') = do - x' <- GC.compileExp x - stms <- setArgs (i + 1) parts' - return $ [C.cstm|global_failure_args[$int:i] = (typename int64_t)$exp:x';|] : stms - setArgs i (ErrorInt64 x : parts') = do x' <- GC.compileExp x stms <- setArgs (i + 1) parts' return $ [C.cstm|global_failure_args[$int:i] = $exp:x';|] : stms diff --git a/src/Futhark/Construct.hs b/src/Futhark/Construct.hs --- a/src/Futhark/Construct.hs +++ b/src/Futhark/Construct.hs @@ -330,12 +330,12 @@ m (Exp (Lore m)) eSliceArray d arr i n = do arr_t <- lookupType arr - let skips = map (slice (constant (0 :: Int64))) $ take d $ arrayDims arr_t + let skips = map (slice (constant (0 :: Int32))) $ take d $ arrayDims arr_t i' <- letSubExp "slice_i" =<< i n' <- letSubExp "slice_n" =<< n return $ BasicOp $ Index arr $ fullSlice arr_t $ skips ++ [slice i' n'] where - slice j m = DimSlice j m (constant (1 :: Int64)) + slice j m = DimSlice j m (constant (1 :: Int32)) -- | Are these indexes out-of-bounds for the array? eOutOfBounds :: @@ -350,10 +350,10 @@ let checkDim w i = do less_than_zero <- letSubExp "less_than_zero" $ - BasicOp $ CmpOp (CmpSlt Int64) i (constant (0 :: Int64)) + BasicOp $ CmpOp (CmpSlt Int32) i (constant (0 :: Int32)) greater_than_size <- letSubExp "greater_than_size" $ - BasicOp $ CmpOp (CmpSle Int64) w i + BasicOp $ CmpOp (CmpSle Int32) w i letSubExp "outside_bounds_dim" $ BasicOp $ BinOp LogOr less_than_zero greater_than_size foldBinOp LogOr (constant False) =<< zipWithM checkDim ws is' @@ -479,7 +479,7 @@ -- | Slice a full dimension of the given size. sliceDim :: SubExp -> DimIndex SubExp -sliceDim d = DimSlice (constant (0 :: Int64)) d (constant (1 :: Int64)) +sliceDim d = DimSlice (constant (0 :: Int32)) d (constant (1 :: Int32)) -- | @fullSlice t slice@ returns @slice@, but with 'DimSlice's of -- entire dimensions appended to the full dimensionality of @t@. This @@ -579,7 +579,7 @@ runWriterT $ instantiateShapes instantiate ts where instantiate _ = do - v <- lift $ newIdent "size" $ Prim int64 + v <- lift $ newIdent "size" $ Prim int32 tell [v] return $ Var $ identName v diff --git a/src/Futhark/IR/Kernels/Kernel.hs b/src/Futhark/IR/Kernels/Kernel.hs --- a/src/Futhark/IR/Kernels/Kernel.hs +++ b/src/Futhark/IR/Kernels/Kernel.hs @@ -204,11 +204,11 @@ cheapOp _ = True instance TypedOp SizeOp where - opType SplitSpace {} = pure [Prim int64] - opType (GetSize _ _) = pure [Prim int64] - opType (GetSizeMax _) = pure [Prim int64] + opType SplitSpace {} = pure [Prim int32] + opType (GetSize _ _) = pure [Prim int32] + opType (GetSizeMax _) = pure [Prim int32] opType CmpSizeLe {} = pure [Prim Bool] - opType CalcNumGroups {} = pure [Prim int64] + opType CalcNumGroups {} = pure [Prim int32] instance AliasedOp SizeOp where opAliases _ = [mempty] @@ -251,14 +251,14 @@ typeCheckSizeOp (SplitSpace o w i elems_per_thread) = do case o of SplitContiguous -> return () - SplitStrided stride -> TC.require [Prim int64] stride - mapM_ (TC.require [Prim int64]) [w, i, elems_per_thread] + SplitStrided stride -> TC.require [Prim int32] stride + mapM_ (TC.require [Prim int32]) [w, i, elems_per_thread] typeCheckSizeOp GetSize {} = return () typeCheckSizeOp GetSizeMax {} = return () -typeCheckSizeOp (CmpSizeLe _ _ x) = TC.require [Prim int64] x +typeCheckSizeOp (CmpSizeLe _ _ x) = TC.require [Prim int32] x typeCheckSizeOp (CalcNumGroups w _ group_size) = do TC.require [Prim int64] w - TC.require [Prim int64] group_size + TC.require [Prim int32] group_size -- | A host-level operation; parameterised by what else it can do. data HostOp lore op @@ -357,8 +357,8 @@ SegLevel -> TC.TypeM lore () checkSegLevel Nothing lvl = do - TC.require [Prim int64] $ unCount $ segNumGroups lvl - TC.require [Prim int64] $ unCount $ segGroupSize lvl + 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 diff --git a/src/Futhark/IR/Kernels/Sizes.hs b/src/Futhark/IR/Kernels/Sizes.hs --- a/src/Futhark/IR/Kernels/Sizes.hs +++ b/src/Futhark/IR/Kernels/Sizes.hs @@ -17,7 +17,7 @@ where import Control.Category -import Data.Int (Int64) +import Data.Int (Int32) import Data.Traversable import Futhark.IR.Prop.Names (FreeIn) import Futhark.Transform.Substitute @@ -37,7 +37,7 @@ -- impose constraints on the valid values. data SizeClass = -- | A threshold with an optional default. - SizeThreshold KernelPath (Maybe Int64) + SizeThreshold KernelPath (Maybe Int32) | SizeGroup | SizeNumGroups | SizeTile @@ -45,7 +45,7 @@ -- maximum can be handy. SizeLocalMemory | -- | A bespoke size with a default. - SizeBespoke Name Int64 + SizeBespoke Name Int32 deriving (Eq, Ord, Show, Generic) instance SexpIso SizeClass where @@ -72,7 +72,7 @@ ppr (SizeBespoke k _) = ppr k -- | The default value for the size. If 'Nothing', that means the backend gets to decide. -sizeDefault :: SizeClass -> Maybe Int64 +sizeDefault :: SizeClass -> Maybe Int32 sizeDefault (SizeThreshold _ x) = x sizeDefault (SizeBespoke _ x) = Just x sizeDefault _ = Nothing diff --git a/src/Futhark/IR/Mem.hs b/src/Futhark/IR/Mem.hs --- a/src/Futhark/IR/Mem.hs +++ b/src/Futhark/IR/Mem.hs @@ -248,10 +248,10 @@ indexOp _ _ _ _ = Nothing -- | The index function representation used for memory annotations. -type IxFun = IxFun.IxFun (TPrimExp Int64 VName) +type IxFun = IxFun.IxFun (TPrimExp Int32 VName) -- | An index function that may contain existential variables. -type ExtIxFun = IxFun.IxFun (TPrimExp Int64 (Ext VName)) +type ExtIxFun = IxFun.IxFun (TPrimExp Int32 (Ext VName)) -- | A summary of the memory information for every let-bound -- identifier, function parameter, and return value. Parameterisered @@ -333,13 +333,13 @@ Engine.SimplifiableLore lore => IxFun -> Engine.SimpleM lore IxFun -simplifyIxFun = traverse $ fmap isInt64 . simplifyPrimExp . untyped +simplifyIxFun = traverse $ fmap isInt32 . simplifyPrimExp . untyped simplifyExtIxFun :: Engine.SimplifiableLore lore => ExtIxFun -> Engine.SimpleM lore ExtIxFun -simplifyExtIxFun = traverse $ fmap isInt64 . simplifyExtPrimExp . untyped +simplifyExtIxFun = traverse $ fmap isInt32 . simplifyExtPrimExp . untyped isStaticIxFun :: ExtIxFun -> Maybe IxFun isStaticIxFun = traverse $ traverse inst @@ -467,22 +467,22 @@ ReturnsInBlock v $ fixExtIxFun i - (primExpFromSubExp int64 (Var v)) + (primExpFromSubExp int32 (Var v)) ixfun fixExt i se (ReturnsNewBlock space j ixfun) = ReturnsNewBlock space j' - (fixExtIxFun i (primExpFromSubExp int64 se) ixfun) + (fixExtIxFun i (primExpFromSubExp int32 se) ixfun) where j' | i < j = j -1 | otherwise = j fixExt i se (ReturnsInBlock mem ixfun) = - ReturnsInBlock mem (fixExtIxFun i (primExpFromSubExp int64 se) ixfun) + ReturnsInBlock mem (fixExtIxFun i (primExpFromSubExp int32 se) ixfun) fixExtIxFun :: Int -> PrimExp VName -> ExtIxFun -> ExtIxFun -fixExtIxFun i e = fmap $ isInt64 . replaceInPrimExp update . untyped +fixExtIxFun i e = fmap $ isInt32 . replaceInPrimExp update . untyped where update (Ext j) t | j > i = LeafExp (Ext $ j - 1) t @@ -490,8 +490,8 @@ | otherwise = LeafExp (Ext j) t update (Free x) t = LeafExp (Free x) t -leafExp :: Int -> TPrimExp Int64 (Ext a) -leafExp i = isInt64 $ LeafExp (Ext i) int64 +leafExp :: Int -> TPrimExp Int32 (Ext a) +leafExp i = isInt32 $ LeafExp (Ext i) int32 existentialiseIxFun :: [VName] -> IxFun -> ExtIxFun existentialiseIxFun ctx = IxFun.substituteInIxFun ctx' . fmap (fmap Free) @@ -657,15 +657,15 @@ -- occurs. getExtMaps :: [(VName, Int)] -> - ( M.Map (Ext VName) (TPrimExp Int64 (Ext VName)), - M.Map (Ext VName) (TPrimExp Int64 (Ext VName)) + ( M.Map (Ext VName) (TPrimExp Int32 (Ext VName)), + M.Map (Ext VName) (TPrimExp Int32 (Ext VName)) ) getExtMaps ctx_lst_ids = ( M.map leafExp $ M.mapKeys Free $ M.fromListWith (flip const) ctx_lst_ids, M.fromList $ mapMaybe ( traverse - ( fmap (\i -> isInt64 $ LeafExp (Ext i) int64) + ( fmap (\i -> isInt32 $ LeafExp (Ext i) int32) . (`lookup` ctx_lst_ids) ) . uncurry (flip (,)) @@ -928,7 +928,7 @@ lookupArraySummary :: (Mem lore, HasScope lore m, Monad m) => VName -> - m (VName, IxFun.IxFun (TPrimExp Int64 VName)) + m (VName, IxFun.IxFun (TPrimExp Int32 VName)) lookupArraySummary name = do summary <- lookupMemInfo name case summary of @@ -943,7 +943,7 @@ MemInfo SubExp u MemBind -> TC.TypeM lore () checkMemInfo _ (MemPrim _) = return () -checkMemInfo _ (MemMem (ScalarSpace d _)) = mapM_ (TC.require [Prim int64]) d +checkMemInfo _ (MemMem (ScalarSpace d _)) = mapM_ (TC.require [Prim int32]) d checkMemInfo _ (MemMem _) = return () checkMemInfo name (MemArray _ shape _ (ArrayIn v ixfun)) = do t <- lookupType v @@ -959,7 +959,7 @@ ++ "." TC.context ("in index function " ++ pretty ixfun) $ do - traverse_ (TC.requirePrimExp int64 . untyped) ixfun + traverse_ (TC.requirePrimExp int32 . untyped) ixfun let ixfun_rank = IxFun.rank ixfun ident_rank = shapeRank shape unless (ixfun_rank == ident_rank) $ @@ -1044,8 +1044,8 @@ IxFun.iota $ map convert $ shapeDims shape | otherwise = return $ MemArray bt shape u Nothing - convert (Ext i) = le64 (Ext i) - convert (Free v) = Free <$> pe64 v + convert (Ext i) = le32 (Ext i) + convert (Free v) = Free <$> pe32 v arrayVarReturns :: (HasScope lore m, Monad m, Mem lore) => @@ -1095,7 +1095,7 @@ Just $ ReturnsInBlock mem $ existentialiseIxFun [] $ - IxFun.reshape ixfun $ map (fmap pe64) newshape + IxFun.reshape ixfun $ map (fmap pe32) newshape ] expReturns (BasicOp (Rearrange perm v)) = do (et, Shape dims, mem, ixfun) <- arrayVarReturns v @@ -1107,7 +1107,7 @@ ] expReturns (BasicOp (Rotate offsets v)) = do (et, Shape dims, mem, ixfun) <- arrayVarReturns v - let offsets' = map pe64 offsets + let offsets' = map pe32 offsets ixfun' = IxFun.rotate ixfun offsets' return [ MemArray et (Shape $ map Free dims) NoUniqueness $ @@ -1176,7 +1176,7 @@ ArrayIn mem $ IxFun.slice ixfun - (map (fmap (isInt64 . primExpFromSubExp int64)) slice) + (map (fmap (isInt32 . primExpFromSubExp int32)) slice) class TypedOp (Op lore) => OpReturns lore where opReturns :: diff --git a/src/Futhark/IR/Pretty.hs b/src/Futhark/IR/Pretty.hs --- a/src/Futhark/IR/Pretty.hs +++ b/src/Futhark/IR/Pretty.hs @@ -237,7 +237,6 @@ where p (ErrorString s) = text $ show s p (ErrorInt32 x) = ppr x - p (ErrorInt64 x) = ppr x instance PrettyLore lore => Pretty (Exp lore) where ppr (If c t f (IfDec _ ifsort)) = diff --git a/src/Futhark/IR/Prop/TypeOf.hs b/src/Futhark/IR/Prop/TypeOf.hs --- a/src/Futhark/IR/Prop/TypeOf.hs +++ b/src/Futhark/IR/Prop/TypeOf.hs @@ -66,7 +66,7 @@ primOpType (ArrayLit es rt) = pure [arrayOf rt (Shape [n]) NoUniqueness] where - n = intConst Int64 $ toInteger $ length es + n = intConst Int32 $ toInteger $ length es primOpType (BinOp bop _ _) = pure [Prim $ binOpType bop] primOpType (UnOp _ x) = @@ -147,7 +147,7 @@ f <*> x = FeelBad $ feelBad f $ feelBad x instance Decorations lore => HasScope lore (FeelBad lore) where - lookupType = const $ pure $ Prim $ IntType Int64 + lookupType = const $ pure $ Prim $ IntType Int32 askScope = pure mempty -- | Given the context and value merge parameters of a Futhark @loop@, diff --git a/src/Futhark/IR/Prop/Types.hs b/src/Futhark/IR/Prop/Types.hs --- a/src/Futhark/IR/Prop/Types.hs +++ b/src/Futhark/IR/Prop/Types.hs @@ -246,7 +246,7 @@ shapeSize :: Int -> Shape -> SubExp shapeSize i shape = case drop i $ shapeDims shape of e : _ -> e - [] -> constant (0 :: Int64) + [] -> constant (0 :: Int32) -- | Return the dimensions of a type - for non-arrays, this is the -- empty list. @@ -267,7 +267,7 @@ -- the given type list. If the dimension does not exist, or no types -- are given, the zero constant is returned. arraysSize :: Int -> [TypeBase Shape u] -> SubExp -arraysSize _ [] = constant (0 :: Int64) +arraysSize _ [] = constant (0 :: Int32) arraysSize i (t : _) = arraySize i t -- | Return the immediate row-type of an array. For @[[int]]@, this diff --git a/src/Futhark/IR/SOACS/SOAC.hs b/src/Futhark/IR/SOACS/SOAC.hs --- a/src/Futhark/IR/SOACS/SOAC.hs +++ b/src/Futhark/IR/SOACS/SOAC.hs @@ -659,13 +659,13 @@ typeCheckSOAC :: TC.Checkable lore => SOAC (Aliases lore) -> TC.TypeM lore () typeCheckSOAC (Stream size form lam arrexps) = do let accexps = getStreamAccums form - TC.require [Prim int64] size + TC.require [Prim int32] size accargs <- mapM TC.checkArg accexps arrargs <- mapM lookupType arrexps _ <- TC.checkSOACArrayArgs size arrexps let chunk = head $ lambdaParams lam let asArg t = (t, mempty) - inttp = Prim int64 + inttp = Prim int32 lamarrs' = map (`setOuterSize` Var (paramName chunk)) arrargs let acc_len = length accexps let lamrtp = take acc_len $ lambdaReturnType lam @@ -698,7 +698,7 @@ -- 1. The number of index types must be equal to the number of value types -- and the number of writes to arrays in @as@. -- - -- 2. Each index type must have the type i64. + -- 2. Each index type must have the type i32. -- -- 3. Each array in @as@ and the value types must have the same type -- @@ -712,7 +712,7 @@ -- Code: -- First check the input size. - TC.require [Prim int64] w + TC.require [Prim int32] w -- 0. let (_as_ws, as_ns, _as_vs) = unzip3 as @@ -727,12 +727,12 @@ -- 2. forM_ rtsI $ \rtI -> - unless (Prim int64 == rtI) $ - TC.bad $ TC.TypeError "Scatter: Index return type must be i64." + unless (Prim int32 == rtI) $ + TC.bad $ TC.TypeError "Scatter: Index return type must be i32." forM_ (zip (chunks as_ns rtsV) as) $ \(rtVs, (aw, _, a)) -> do - -- All lengths must have type i64. - TC.require [Prim int64] aw + -- All lengths must have type i32. + TC.require [Prim int32] aw -- 3. forM_ rtVs $ \rtV -> TC.requireI [rtV `arrayOfRow` aw] a @@ -744,13 +744,13 @@ arrargs <- TC.checkSOACArrayArgs w ivs TC.checkLambda lam arrargs typeCheckSOAC (Hist len ops bucket_fun imgs) = do - TC.require [Prim int64] len + TC.require [Prim int32] len -- Check the operators. forM_ ops $ \(HistOp dest_w rf dests nes op) -> do nes' <- mapM TC.checkArg nes - TC.require [Prim int64] dest_w - TC.require [Prim int64] rf + TC.require [Prim int32] dest_w + TC.require [Prim int32] rf -- Operator type must match the type of neutral elements. TC.checkLambda op $ map TC.noArgAliases $ nes' ++ nes' @@ -775,7 +775,7 @@ -- Return type of bucket function must be an index for each -- operation followed by the values to write. nes_ts <- concat <$> mapM (mapM subExpType . histNeutral) ops - let bucket_ret_t = replicate (length ops) (Prim int64) ++ nes_ts + let bucket_ret_t = replicate (length ops) (Prim int32) ++ nes_ts unless (bucket_ret_t == lambdaReturnType bucket_fun) $ TC.bad $ TC.TypeError $ @@ -784,7 +784,7 @@ ++ " but should have type " ++ prettyTuple bucket_ret_t typeCheckSOAC (Screma w (ScremaForm scans reds map_lam) arrs) = do - TC.require [Prim int64] w + TC.require [Prim int32] w arrs' <- TC.checkSOACArrayArgs w arrs TC.checkLambda map_lam $ map TC.noArgAliases arrs' diff --git a/src/Futhark/IR/SOACS/Simplify.hs b/src/Futhark/IR/SOACS/Simplify.hs --- a/src/Futhark/IR/SOACS/Simplify.hs +++ b/src/Futhark/IR/SOACS/Simplify.hs @@ -517,7 +517,7 @@ Simplify $ certifying (stmAuxCerts aux1 <> cs) $ letBind pat $ - BasicOp $ Rotate (intConst Int64 0 : rots) arr + BasicOp $ Rotate (intConst Int32 0 : rots) arr mapOpToOp _ _ _ _ = Skip isMapWithOp :: @@ -680,7 +680,7 @@ bindMapParam p a = do a_t <- lookupType a letBindNames [paramName p] $ - BasicOp $ Index a $ fullSlice a_t [DimFix $ constant (0 :: Int64)] + BasicOp $ Index a $ fullSlice a_t [DimFix $ constant (0 :: Int32)] bindArrayResult pe se = letBindNames [patElemName pe] $ BasicOp $ ArrayLit [se] $ rowType $ patElemType pe @@ -705,7 +705,7 @@ partitionChunkedFoldParameters (length nes) (lambdaParams fold_lam) letBindNames [paramName chunk_param] $ - BasicOp $ SubExp $ intConst Int64 1 + BasicOp $ SubExp $ intConst Int32 1 forM_ (zip acc_params nes) $ \(p, ne) -> letBindNames [paramName p] $ BasicOp $ SubExp ne @@ -858,7 +858,7 @@ letExp (baseString arr ++ "_prefix") $ BasicOp $ Index arr $ - fullSlice arr_t [DimSlice (intConst Int64 0) w (intConst Int64 1)] + fullSlice arr_t [DimSlice (intConst Int32 0) w (intConst Int32 1)] return $ Just ( arr', @@ -920,7 +920,7 @@ mapOverArr op | Just (_, arr) <- find ((== arrayOpArr op) . fst) (zip map_param_names arrs) = do arr_t <- lookupType arr - let whole_dim = DimSlice (intConst Int64 0) (arraySize 0 arr_t) (intConst Int64 1) + let whole_dim = DimSlice (intConst Int32 0) (arraySize 0 arr_t) (intConst Int32 1) arr_transformed <- certifying (arrayOpCerts op) $ letExp (baseString arr ++ "_transformed") $ case op of @@ -929,7 +929,7 @@ ArrayRearrange _ _ perm -> BasicOp $ Rearrange (0 : map (+ 1) perm) arr ArrayRotate _ _ rots -> - BasicOp $ Rotate (intConst Int64 0 : rots) arr + BasicOp $ Rotate (intConst Int32 0 : rots) arr ArrayVar {} -> BasicOp $ SubExp $ Var arr arr_transformed_t <- lookupType arr_transformed diff --git a/src/Futhark/IR/SegOp.hs b/src/Futhark/IR/SegOp.hs --- a/src/Futhark/IR/SegOp.hs +++ b/src/Futhark/IR/SegOp.hs @@ -395,10 +395,10 @@ checkKernelResult (Returns _ what) t = TC.require [t] what checkKernelResult (WriteReturns rws arr res) t = do - mapM_ (TC.require [Prim int64]) rws + mapM_ (TC.require [Prim int32]) rws arr_t <- lookupType arr forM_ res $ \(slice, e) -> do - mapM_ (traverse $ TC.require [Prim int64]) slice + mapM_ (traverse $ TC.require [Prim int32]) slice TC.require [t] e unless (arr_t == t `arrayOfShape` Shape rws) $ TC.bad $ @@ -415,16 +415,16 @@ checkKernelResult (ConcatReturns o w per_thread_elems v) t = do case o of SplitContiguous -> return () - SplitStrided stride -> TC.require [Prim int64] stride - TC.require [Prim int64] w - TC.require [Prim int64] per_thread_elems + SplitStrided stride -> TC.require [Prim int32] stride + TC.require [Prim int32] w + TC.require [Prim int32] per_thread_elems vt <- lookupType v unless (vt == t `arrayOfRow` arraySize 0 vt) $ TC.bad $ TC.TypeError $ "Invalid type for ConcatReturns " ++ pretty v checkKernelResult (TileReturns dims v) t = do forM_ dims $ \(dim, tile) -> do - TC.require [Prim int64] dim - TC.require [Prim int64] tile + TC.require [Prim int32] dim + TC.require [Prim int32] tile vt <- lookupType v unless (vt == t `arrayOfShape` Shape (map snd dims)) $ TC.bad $ TC.TypeError $ "Invalid type for TileReturns " ++ pretty v @@ -514,11 +514,11 @@ -- this 'SegSpace'. scopeOfSegSpace :: SegSpace -> Scope lore scopeOfSegSpace (SegSpace phys space) = - M.fromList $ zip (phys : map fst space) $ repeat $ IndexName Int64 + M.fromList $ zip (phys : map fst space) $ repeat $ IndexName Int32 checkSegSpace :: TC.Checkable lore => SegSpace -> TC.TypeM lore () checkSegSpace (SegSpace _ dims) = - mapM_ (TC.require [Prim int64] . snd) dims + mapM_ (TC.require [Prim int32] . snd) dims -- | A 'SegOp' is semantically a perfectly nested stack of maps, on -- top of some bottommost computation (scalar computation, reduction, @@ -662,10 +662,10 @@ TC.binding (scopeOfSegSpace space) $ do nes_ts <- forM ops $ \(HistOp dest_w rf dests nes shape op) -> do - TC.require [Prim int64] dest_w - TC.require [Prim int64] rf + TC.require [Prim int32] dest_w + TC.require [Prim int32] rf nes' <- mapM TC.checkArg nes - mapM_ (TC.require [Prim int64]) $ shapeDims shape + mapM_ (TC.require [Prim int32]) $ shapeDims shape -- Operator type must match the type of neutral elements. let stripVecDims = stripArray $ shapeRank shape @@ -691,7 +691,7 @@ -- Return type of bucket function must be an index for each -- operation followed by the values to write. - let bucket_ret_t = replicate (length ops) (Prim int64) ++ concat nes_ts + let bucket_ret_t = replicate (length ops) (Prim int32) ++ concat nes_ts unless (bucket_ret_t == ts) $ TC.bad $ TC.TypeError $ @@ -715,7 +715,7 @@ TC.binding (scopeOfSegSpace space) $ do ne_ts <- forM ops $ \(lam, nes, shape) -> do - mapM_ (TC.require [Prim int64]) $ shapeDims shape + mapM_ (TC.require [Prim int32]) $ shapeDims shape nes' <- mapM TC.checkArg nes -- Operator type must match the type of neutral elements. @@ -1018,7 +1018,7 @@ ST.IndexedArray (stmCerts stm <> cs) arr - (fixSlice (map (fmap isInt64) slice') excess_is) + (fixSlice (map (fmap isInt32) slice') excess_is) in M.insert v idx table | otherwise = table @@ -1119,9 +1119,9 @@ segSpaceSymbolTable :: ASTLore lore => SegSpace -> ST.SymbolTable lore segSpaceSymbolTable (SegSpace flat gtids_and_dims) = - foldl' f (ST.fromScope $ M.singleton flat $ IndexName Int64) gtids_and_dims + foldl' f (ST.fromScope $ M.singleton flat $ IndexName Int32) gtids_and_dims where - f vtable (gtid, dim) = ST.insertLoopVar gtid Int64 dim vtable + f vtable (gtid, dim) = ST.insertLoopVar gtid Int32 dim vtable simplifySegBinOp :: Engine.SimplifiableLore lore => @@ -1385,9 +1385,9 @@ map ( \d -> DimSlice - (constant (0 :: Int64)) + (constant (0 :: Int32)) d - (constant (1 :: Int64)) + (constant (1 :: Int32)) ) $ segSpaceDims space index kpe' = diff --git a/src/Futhark/IR/Syntax/Core.hs b/src/Futhark/IR/Syntax/Core.hs --- a/src/Futhark/IR/Syntax/Core.hs +++ b/src/Futhark/IR/Syntax/Core.hs @@ -484,18 +484,15 @@ ErrorString String | -- | A run-time integer value. ErrorInt32 a - | -- | A bigger run-time integer value. - ErrorInt64 a deriving (Eq, Ord, Show, Generic) instance SexpIso a => SexpIso (ErrorMsgPart a) where sexpIso = match $ With (. Sexp.list (Sexp.el (Sexp.sym "error-string") . Sexp.el (iso T.unpack T.pack . sexpIso))) $ - With (. Sexp.list (Sexp.el (Sexp.sym "error-int32") . Sexp.el sexpIso)) $ - With - (. Sexp.list (Sexp.el (Sexp.sym "error-int64") . Sexp.el sexpIso)) - End + With + (. Sexp.list (Sexp.el (Sexp.sym "error-int32") . Sexp.el sexpIso)) + End instance IsString (ErrorMsgPart a) where fromString = ErrorString @@ -512,17 +509,14 @@ instance Functor ErrorMsgPart where fmap _ (ErrorString s) = ErrorString s fmap f (ErrorInt32 a) = ErrorInt32 $ f a - fmap f (ErrorInt64 a) = ErrorInt64 $ f a instance Foldable ErrorMsgPart where foldMap _ ErrorString {} = mempty foldMap f (ErrorInt32 a) = f a - foldMap f (ErrorInt64 a) = f a instance Traversable ErrorMsgPart where traverse _ (ErrorString s) = pure $ ErrorString s traverse f (ErrorInt32 a) = ErrorInt32 <$> f a - traverse f (ErrorInt64 a) = ErrorInt64 <$> f a -- | How many non-constant parts does the error message have, and what -- is their type? @@ -531,4 +525,3 @@ where onPart ErrorString {} = Nothing onPart ErrorInt32 {} = Just $ IntType Int32 - onPart ErrorInt64 {} = Just $ IntType Int64 diff --git a/src/Futhark/Internalise.hs b/src/Futhark/Internalise.hs --- a/src/Futhark/Internalise.hs +++ b/src/Futhark/Internalise.hs @@ -105,7 +105,7 @@ return $ Param v $ toDecl v_t Nonunique let free_shape_params = - map (`Param` I.Prim int64) $ + map (`Param` I.Prim int32) $ concatMap (I.shapeVars . I.arrayShape . I.paramType) used_free_params free_params = nub $ free_shape_params ++ used_free_params all_params = free_params ++ shapeparams ++ concat params' @@ -353,7 +353,7 @@ flat_arr_t <- lookupType flat_arr let new_shape' = reshapeOuter - (map (DimNew . intConst Int64 . toInteger) new_shape) + (map (DimNew . intConst Int32 . toInteger) new_shape) 1 $ I.arrayShape flat_arr_t letSubExp desc $ I.BasicOp $ I.Reshape new_shape' flat_arr @@ -409,25 +409,25 @@ -- Construct an error message in case the range is invalid. let conv = case E.typeOf start of - E.Scalar (E.Prim (E.Unsigned _)) -> asIntZ Int64 - _ -> asIntS Int64 - start'_i64 <- conv start' - end'_i64 <- conv end' - maybe_second'_i64 <- traverse conv maybe_second' + E.Scalar (E.Prim (E.Unsigned _)) -> asIntS Int32 + _ -> asIntS Int32 + start'_i32 <- conv start' + end'_i32 <- conv end' + maybe_second'_i32 <- traverse conv maybe_second' let errmsg = errorMsg $ ["Range "] - ++ [ErrorInt64 start'_i64] - ++ ( case maybe_second'_i64 of + ++ [ErrorInt32 start'_i32] + ++ ( case maybe_second'_i32 of Nothing -> [] - Just second_i64 -> ["..", ErrorInt64 second_i64] + Just second_i32 -> ["..", ErrorInt32 second_i32] ) ++ ( case end of DownToExclusive {} -> ["..>"] ToInclusive {} -> ["..."] UpToExclusive {} -> ["..<"] ) - ++ [ErrorInt64 end'_i64, " is invalid."] + ++ [ErrorInt32 end'_i32, " is invalid."] (it, le_op, lt_op) <- case E.typeOf start of @@ -453,7 +453,7 @@ return (default_step, constant False) step_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum it) step - step_sign_i64 <- asIntS Int64 step_sign + step_sign_i32 <- asIntS Int32 step_sign bounds_invalid_downwards <- letSubExp "bounds_invalid_downwards" $ @@ -470,15 +470,15 @@ distance <- letSubExp "distance" $ I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) start' end' - distance_i64 <- asIntS Int64 distance - return (distance_i64, step_wrong_dir, bounds_invalid_downwards) + distance_i32 <- asIntS Int32 distance + return (distance_i32, step_wrong_dir, bounds_invalid_downwards) UpToExclusive {} -> do step_wrong_dir <- letSubExp "step_wrong_dir" $ I.BasicOp $ I.CmpOp (I.CmpEq $ IntType it) step_sign negone distance <- letSubExp "distance" $ I.BasicOp $ I.BinOp (Sub it I.OverflowWrap) end' start' - distance_i64 <- asIntS Int64 distance - return (distance_i64, step_wrong_dir, bounds_invalid_upwards) + distance_i32 <- asIntS Int32 distance + return (distance_i32, step_wrong_dir, bounds_invalid_upwards) ToInclusive {} -> do downwards <- letSubExp "downwards" $ @@ -504,14 +504,14 @@ (resultBody [distance_downwards_exclusive]) (resultBody [distance_upwards_exclusive]) $ ifCommon [I.Prim $ IntType it] - distance_exclusive_i64 <- asIntS Int64 distance_exclusive + distance_exclusive_i32 <- asIntS Int32 distance_exclusive distance <- letSubExp "distance" $ I.BasicOp $ I.BinOp - (Add Int64 I.OverflowWrap) - distance_exclusive_i64 - (intConst Int64 1) + (Add Int32 I.OverflowWrap) + distance_exclusive_i32 + (intConst Int32 1) return (distance, constant False, bounds_invalid) step_invalid <- @@ -524,15 +524,15 @@ valid <- letSubExp "valid" $ I.BasicOp $ I.UnOp I.Not invalid cs <- assert "range_valid_c" valid errmsg loc - step_i64 <- asIntS Int64 step + step_i32 <- asIntS Int32 step pos_step <- letSubExp "pos_step" $ - I.BasicOp $ I.BinOp (Mul Int64 I.OverflowWrap) step_i64 step_sign_i64 + I.BasicOp $ I.BinOp (Mul Int32 I.OverflowWrap) step_i32 step_sign_i32 num_elems <- certifying cs $ letSubExp "num_elems" $ - I.BasicOp $ I.BinOp (SDivUp Int64 I.Unsafe) distance pos_step + I.BasicOp $ I.BinOp (SDivUp Int32 I.Unsafe) distance pos_step se <- letSubExp desc (I.BasicOp $ I.Iota num_elems start' step it) bindExtSizes (E.toStruct ret) retext [se] @@ -548,7 +548,7 @@ dims <- arrayDims <$> subExpType e' let parts = ["Value of (core language) shape ("] - ++ intersperse ", " (map ErrorInt64 dims) + ++ intersperse ", " (map ErrorInt32 dims) ++ [") cannot match shape of type `"] ++ dt' ++ ["`."] @@ -677,7 +677,7 @@ bindingLambdaParams [x] (map rowType arr_ts) $ \x_params -> do let loopvars = zip x_params arr' forLoop mergepat' shapepat mergeinit $ - I.ForLoop i Int64 w loopvars + I.ForLoop i Int32 w loopvars handleForm mergeinit (E.For i num_iterations) = do num_iterations' <- internaliseExp1 "upper_bound" num_iterations i' <- internaliseIdent i @@ -814,7 +814,7 @@ (ts, constr_map) <- internaliseSumType $ M.map (map E.toStruct) fs es' <- concat <$> mapM (internaliseExp "payload") es - let noExt _ = return $ intConst Int64 0 + let noExt _ = return $ intConst Int32 0 ts' <- instantiateShapes noExt $ map fromDecl ts case M.lookup c constr_map of @@ -1037,7 +1037,7 @@ errorMsg $ ["Index ["] ++ intercalate [", "] parts ++ ["] out of bounds for array of shape ["] - ++ intersperse "][" (map ErrorInt64 $ take (length idxs) dims) + ++ intersperse "][" (map ErrorInt32 $ take (length idxs) dims) ++ ["]."] c <- assert "index_certs" ok msg loc return (idxs', c) @@ -1050,12 +1050,12 @@ (i', _) <- internaliseDimExp "i" i let lowerBound = I.BasicOp $ - I.CmpOp (I.CmpSle I.Int64) (I.constant (0 :: I.Int64)) i' + I.CmpOp (I.CmpSle I.Int32) (I.constant (0 :: I.Int32)) i' upperBound = I.BasicOp $ - I.CmpOp (I.CmpSlt I.Int64) i' w + I.CmpOp (I.CmpSlt I.Int32) i' w ok <- letSubExp "bounds_check" =<< eBinOp I.LogAnd (pure lowerBound) (pure upperBound) - return (I.DimFix i', ok, [ErrorInt64 i']) + return (I.DimFix i', ok, [ErrorInt32 i']) -- Special-case an important common case that otherwise leads to horrible code. internaliseDimIndex @@ -1067,45 +1067,45 @@ ) = do w_minus_1 <- letSubExp "w_minus_1" $ - BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) w one + BasicOp $ I.BinOp (Sub Int32 I.OverflowWrap) w one return - ( I.DimSlice w_minus_1 w $ intConst Int64 (-1), + ( I.DimSlice w_minus_1 w $ intConst Int32 (-1), constant True, mempty ) where - one = constant (1 :: Int64) + one = constant (1 :: Int32) internaliseDimIndex w (E.DimSlice i j s) = do s' <- maybe (return one) (fmap fst . internaliseDimExp "s") s - s_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum Int64) s' - backwards <- letSubExp "backwards" $ I.BasicOp $ I.CmpOp (I.CmpEq int64) s_sign negone - w_minus_1 <- letSubExp "w_minus_1" $ BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) w one + s_sign <- letSubExp "s_sign" $ BasicOp $ I.UnOp (I.SSignum Int32) s' + backwards <- letSubExp "backwards" $ I.BasicOp $ I.CmpOp (I.CmpEq int32) s_sign negone + w_minus_1 <- letSubExp "w_minus_1" $ BasicOp $ I.BinOp (Sub Int32 I.OverflowWrap) w one let i_def = letSubExp "i_def" $ I.If backwards (resultBody [w_minus_1]) (resultBody [zero]) - $ ifCommon [I.Prim int64] + $ ifCommon [I.Prim int32] j_def = letSubExp "j_def" $ I.If backwards (resultBody [negone]) (resultBody [w]) - $ ifCommon [I.Prim int64] + $ ifCommon [I.Prim int32] i' <- maybe i_def (fmap fst . internaliseDimExp "i") i j' <- maybe j_def (fmap fst . internaliseDimExp "j") j - j_m_i <- letSubExp "j_m_i" $ BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) j' i' + j_m_i <- letSubExp "j_m_i" $ BasicOp $ I.BinOp (Sub Int32 I.OverflowWrap) j' i' -- Something like a division-rounding-up, but accomodating negative -- operands. let divRounding x y = eBinOp - (SQuot Int64 Unsafe) + (SQuot Int32 Unsafe) ( eBinOp - (Add Int64 I.OverflowWrap) + (Add Int32 I.OverflowWrap) x - (eBinOp (Sub Int64 I.OverflowWrap) y (eSignum $ toExp s')) + (eBinOp (Sub Int32 I.OverflowWrap) y (eSignum $ toExp s')) ) y n <- letSubExp "n" =<< divRounding (toExp j_m_i) (toExp s') @@ -1114,29 +1114,29 @@ -- backwards. If forwards, we must check '0 <= i && i <= j'. If -- backwards, '-1 <= j && j <= i'. In both cases, we check '0 <= -- i+n*s && i+(n-1)*s < w'. We only check if the slice is nonempty. - empty_slice <- letSubExp "empty_slice" $ I.BasicOp $ I.CmpOp (CmpEq int64) n zero + empty_slice <- letSubExp "empty_slice" $ I.BasicOp $ I.CmpOp (CmpEq int32) n zero - m <- letSubExp "m" $ I.BasicOp $ I.BinOp (Sub Int64 I.OverflowWrap) n one - m_t_s <- letSubExp "m_t_s" $ I.BasicOp $ I.BinOp (Mul Int64 I.OverflowWrap) m s' - i_p_m_t_s <- letSubExp "i_p_m_t_s" $ I.BasicOp $ I.BinOp (Add Int64 I.OverflowWrap) i' m_t_s + m <- letSubExp "m" $ I.BasicOp $ I.BinOp (Sub Int32 I.OverflowWrap) n one + m_t_s <- letSubExp "m_t_s" $ I.BasicOp $ I.BinOp (Mul Int32 I.OverflowWrap) m s' + i_p_m_t_s <- letSubExp "i_p_m_t_s" $ I.BasicOp $ I.BinOp (Add Int32 I.OverflowWrap) i' m_t_s zero_leq_i_p_m_t_s <- letSubExp "zero_leq_i_p_m_t_s" $ - I.BasicOp $ I.CmpOp (I.CmpSle Int64) zero i_p_m_t_s + I.BasicOp $ I.CmpOp (I.CmpSle Int32) zero i_p_m_t_s i_p_m_t_s_leq_w <- letSubExp "i_p_m_t_s_leq_w" $ - I.BasicOp $ I.CmpOp (I.CmpSle Int64) i_p_m_t_s w + I.BasicOp $ I.CmpOp (I.CmpSle Int32) i_p_m_t_s w i_p_m_t_s_lth_w <- letSubExp "i_p_m_t_s_leq_w" $ - I.BasicOp $ I.CmpOp (I.CmpSlt Int64) i_p_m_t_s w + I.BasicOp $ I.CmpOp (I.CmpSlt Int32) i_p_m_t_s w - zero_lte_i <- letSubExp "zero_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) zero i' - i_lte_j <- letSubExp "i_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) i' j' + zero_lte_i <- letSubExp "zero_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int32) zero i' + i_lte_j <- letSubExp "i_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int32) i' j' forwards_ok <- letSubExp "forwards_ok" =<< eAll [zero_lte_i, zero_lte_i, i_lte_j, zero_leq_i_p_m_t_s, i_p_m_t_s_lth_w] - negone_lte_j <- letSubExp "negone_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) negone j' - j_lte_i <- letSubExp "j_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int64) j' i' + negone_lte_j <- letSubExp "negone_lte_j" $ I.BasicOp $ I.CmpOp (I.CmpSle Int32) negone j' + j_lte_i <- letSubExp "j_lte_i" $ I.BasicOp $ I.CmpOp (I.CmpSle Int32) j' i' backwards_ok <- letSubExp "backwards_ok" =<< eAll @@ -1155,25 +1155,25 @@ let parts = case (i, j, s) of (_, _, Just {}) -> - [ maybe "" (const $ ErrorInt64 i') i, + [ maybe "" (const $ ErrorInt32 i') i, ":", - maybe "" (const $ ErrorInt64 j') j, + maybe "" (const $ ErrorInt32 j') j, ":", - ErrorInt64 s' + ErrorInt32 s' ] (_, Just {}, _) -> - [ maybe "" (const $ ErrorInt64 i') i, + [ maybe "" (const $ ErrorInt32 i') i, ":", - ErrorInt64 j' + ErrorInt32 j' ] - ++ maybe mempty (const [":", ErrorInt64 s']) s + ++ maybe mempty (const [":", ErrorInt32 s']) s (_, Nothing, Nothing) -> - [ErrorInt64 i', ":"] + [ErrorInt32 i', ":"] return (I.DimSlice i' n s', ok_or_empty, parts) where - zero = constant (0 :: Int64) - negone = constant (-1 :: Int64) - one = constant (1 :: Int64) + zero = constant (0 :: Int32) + negone = constant (-1 :: Int32) + one = constant (1 :: Int32) internaliseScanOrReduce :: String -> @@ -1232,10 +1232,10 @@ -- reshape return type of bucket function to have same size as neutral element -- (modulo the index) - bucket_param <- newParam "bucket_p" $ I.Prim int64 + bucket_param <- newParam "bucket_p" $ I.Prim int32 img_params <- mapM (newParam "img_p" . rowType) =<< mapM lookupType img' let params = bucket_param : img_params - rettype = I.Prim int64 : ne_ts + rettype = I.Prim int32 : ne_ts body = mkBody mempty $ map (I.Var . paramName) params body' <- localScope (scopeOfLParams params) $ @@ -1253,7 +1253,7 @@ -- img' are the same size. b_shape <- I.arrayShape <$> lookupType buckets' let b_w = shapeSize 0 b_shape - cmp <- letSubExp "bucket_cmp" $ I.BasicOp $ I.CmpOp (I.CmpEq I.int64) b_w w_img + cmp <- letSubExp "bucket_cmp" $ I.BasicOp $ I.CmpOp (I.CmpEq I.int32) b_w w_img c <- assert "bucket_cert" @@ -1301,7 +1301,7 @@ -- Synthesize neutral elements by applying the fold function -- to an empty chunk. letBindNames [I.paramName chunk_param] $ - I.BasicOp $ I.SubExp $ constant (0 :: Int64) + I.BasicOp $ I.SubExp $ constant (0 :: Int32) forM_ lam_val_params $ \p -> letBindNames [I.paramName p] $ I.BasicOp $ @@ -1366,7 +1366,7 @@ internaliseDimExp s e = do e' <- internaliseExp1 s e case E.typeOf e of - E.Scalar (E.Prim (Signed it)) -> (,it) <$> asIntS Int64 e' + E.Scalar (E.Prim (Signed it)) -> (,it) <$> asIntS Int32 e' _ -> error "internaliseDimExp: bad type" internaliseExpToVars :: String -> E.Exp -> InternaliseM [I.VName] @@ -1665,13 +1665,13 @@ let x_dims = I.arrayDims x_t y_dims = I.arrayDims y_t dims_match <- forM (zip x_dims y_dims) $ \(x_dim, y_dim) -> - letSubExp "dim_eq" $ I.BasicOp $ I.CmpOp (I.CmpEq int64) x_dim y_dim + letSubExp "dim_eq" $ I.BasicOp $ I.CmpOp (I.CmpEq int32) x_dim y_dim shapes_match <- letSubExp "shapes_match" =<< eAll dims_match compare_elems_body <- runBodyBinder $ do -- Flatten both x and y. x_num_elems <- letSubExp "x_num_elems" - =<< foldBinOp (I.Mul Int64 I.OverflowUndef) (constant (1 :: Int64)) x_dims + =<< foldBinOp (I.Mul Int32 I.OverflowUndef) (constant (1 :: Int32)) x_dims x' <- letExp "x" $ I.BasicOp $ I.SubExp x y' <- letExp "x" $ I.BasicOp $ I.SubExp y x_flat <- letExp "x_flat" $ I.BasicOp $ I.Reshape [I.DimNew x_num_elems] x' @@ -1716,7 +1716,7 @@ Just $ \_desc -> do arrs <- internaliseExpToVars "partition_input" arr lam' <- internalisePartitionLambda internaliseLambda k' lam $ map I.Var arrs - uncurry (++) <$> partitionWithSOACS (fromIntegral k') lam' arrs + uncurry (++) <$> partitionWithSOACS k' lam' arrs where fromInt32 (Literal (SignedValue (Int32Value k')) _) = Just k' fromInt32 (IntLit k' (Info (E.Scalar (E.Prim (Signed Int32)))) _) = Just $ fromInteger k' @@ -1764,8 +1764,8 @@ dim_ok <- letSubExp "dim_ok" =<< eCmpOp - (I.CmpEq I.int64) - (eBinOp (I.Mul Int64 I.OverflowUndef) (eSubExp n') (eSubExp m')) + (I.CmpEq I.int32) + (eBinOp (I.Mul Int32 I.OverflowUndef) (eSubExp n') (eSubExp m')) (eSubExp old_dim) dim_ok_cert <- assert @@ -1785,7 +1785,7 @@ arr_t <- lookupType arr' let n = arraySize 0 arr_t m = arraySize 1 arr_t - k <- letSubExp "flat_dim" $ I.BasicOp $ I.BinOp (Mul Int64 I.OverflowUndef) n m + k <- letSubExp "flat_dim" $ I.BasicOp $ I.BinOp (Mul Int32 I.OverflowUndef) n m letSubExp desc $ I.BasicOp $ I.Reshape (reshapeOuter [DimNew k] 2 $ I.arrayShape arr_t) arr' @@ -1796,7 +1796,7 @@ let sumdims xsize ysize = letSubExp "conc_tmp" $ I.BasicOp $ - I.BinOp (I.Add I.Int64 I.OverflowUndef) xsize ysize + I.BinOp (I.Add I.Int32 I.OverflowUndef) xsize ysize ressize <- foldM sumdims outer_size =<< mapM (fmap (arraysSize 0) . mapM lookupType) [ys] @@ -1808,7 +1808,7 @@ offset' <- internaliseExp1 "rotation_offset" offset internaliseOperation desc e $ \v -> do r <- I.arrayRank <$> lookupType v - let zero = intConst Int64 0 + let zero = intConst Int32 0 offsets = offset' : replicate (r -1) zero return $ I.Rotate offsets v handleRest [e] "transpose" = Just $ \desc -> @@ -1888,7 +1888,7 @@ cmp <- letSubExp "write_cmp" $ I.BasicOp $ - I.CmpOp (I.CmpEq I.int64) si_w sv_w + I.CmpOp (I.CmpEq I.int32) si_w sv_w c <- assert "write_cert" @@ -2009,9 +2009,9 @@ _ -> error "partitionWithSOACS" add_lam_x_params <- - replicateM k $ I.Param <$> newVName "x" <*> pure (I.Prim int64) + replicateM k $ I.Param <$> newVName "x" <*> pure (I.Prim int32) add_lam_y_params <- - replicateM k $ I.Param <$> newVName "y" <*> pure (I.Prim int64) + replicateM k $ I.Param <$> newVName "y" <*> pure (I.Prim int32) add_lam_body <- runBodyBinder $ localScope (scopeOfLParams $ add_lam_x_params ++ add_lam_y_params) $ fmap resultBody $ @@ -2019,16 +2019,16 @@ letSubExp "z" $ I.BasicOp $ I.BinOp - (I.Add Int64 I.OverflowUndef) + (I.Add Int32 I.OverflowUndef) (I.Var $ I.paramName x) (I.Var $ I.paramName y) let add_lam = I.Lambda { I.lambdaBody = add_lam_body, I.lambdaParams = add_lam_x_params ++ add_lam_y_params, - I.lambdaReturnType = replicate k $ I.Prim int64 + I.lambdaReturnType = replicate k $ I.Prim int32 } - nes = replicate (length increments) $ intConst Int64 0 + nes = replicate (length increments) $ constant (0 :: Int32) scan <- I.scanSOAC [I.Scan add_lam nes] all_offsets <- letTupExp "offsets" $ I.Op $ I.Screma w scan increments @@ -2036,17 +2036,17 @@ -- We have the offsets for each of the partitions, but we also need -- the total sizes, which are the last elements in the offests. We -- just have to be careful in case the array is empty. - last_index <- letSubExp "last_index" $ I.BasicOp $ I.BinOp (I.Sub Int64 OverflowUndef) w $ constant (1 :: Int64) + last_index <- letSubExp "last_index" $ I.BasicOp $ I.BinOp (I.Sub Int32 OverflowUndef) w $ constant (1 :: Int32) nonempty_body <- runBodyBinder $ fmap resultBody $ forM all_offsets $ \offset_array -> letSubExp "last_offset" $ I.BasicOp $ I.Index offset_array [I.DimFix last_index] - let empty_body = resultBody $ replicate k $ constant (0 :: Int64) - is_empty <- letSubExp "is_empty" $ I.BasicOp $ I.CmpOp (CmpEq int64) w $ constant (0 :: Int64) + let empty_body = resultBody $ replicate k $ constant (0 :: Int32) + is_empty <- letSubExp "is_empty" $ I.BasicOp $ I.CmpOp (CmpEq int32) w $ constant (0 :: Int32) sizes <- letTupExp "partition_size" $ I.If is_empty empty_body nonempty_body $ - ifCommon $ replicate k $ I.Prim int64 + ifCommon $ replicate k $ I.Prim int32 -- The total size of all partitions must necessarily be equal to the -- size of the input array. @@ -2059,8 +2059,8 @@ -- Now write into the result. write_lam <- do - c_param <- I.Param <$> newVName "c" <*> pure (I.Prim int64) - offset_params <- replicateM k $ I.Param <$> newVName "offset" <*> pure (I.Prim int64) + c_param <- I.Param <$> newVName "c" <*> pure (I.Prim int32) + offset_params <- replicateM k $ I.Param <$> newVName "offset" <*> pure (I.Prim int32) value_params <- forM arr_ts $ \arr_t -> I.Param <$> newVName "v" <*> pure (I.rowType arr_t) (offset, offset_stms) <- @@ -2074,7 +2074,7 @@ I.Lambda { I.lambdaParams = c_param : offset_params ++ value_params, I.lambdaReturnType = - replicate (length arr_ts) (I.Prim int64) + replicate (length arr_ts) (I.Prim int32) ++ map I.rowType arr_ts, I.lambdaBody = mkBody offset_stms $ @@ -2092,7 +2092,7 @@ sizes' <- letSubExp "partition_sizes" $ I.BasicOp $ - I.ArrayLit (map I.Var sizes) $ I.Prim int64 + I.ArrayLit (map I.Var sizes) $ I.Prim int32 return (map I.Var results, [sizes']) where mkOffsetLambdaBody :: @@ -2102,26 +2102,26 @@ [I.LParam] -> InternaliseM SubExp mkOffsetLambdaBody _ _ _ [] = - return $ constant (-1 :: Int64) + return $ constant (-1 :: Int32) mkOffsetLambdaBody sizes c i (p : ps) = do is_this_one <- letSubExp "is_this_one" $ I.BasicOp $ - I.CmpOp (CmpEq int64) c $ - intConst Int64 $ toInteger i + I.CmpOp (CmpEq int32) c $ + intConst Int32 $ toInteger i next_one <- mkOffsetLambdaBody sizes c (i + 1) ps this_one <- letSubExp "this_offset" =<< foldBinOp - (Add Int64 OverflowUndef) - (constant (-1 :: Int64)) + (Add Int32 OverflowUndef) + (constant (-1 :: Int32)) (I.Var (I.paramName p) : take i sizes) letSubExp "total_res" $ I.If is_this_one (resultBody [this_one]) (resultBody [next_one]) - $ ifCommon [I.Prim int64] + $ ifCommon [I.Prim int32] typeExpForError :: E.TypeExp VName -> InternaliseM [ErrorMsgPart SubExp] typeExpForError (E.TEVar qn _) = @@ -2165,7 +2165,7 @@ d' <- case substs of Just [v] -> return v _ -> return $ I.Var $ E.qualLeaf d - return $ ErrorInt64 d' + return $ ErrorInt32 d' dimExpForError (DimExpConst d _) = return $ ErrorString $ pretty d dimExpForError DimExpAny = return "" diff --git a/src/Futhark/Internalise/AccurateSizes.hs b/src/Futhark/Internalise/AccurateSizes.hs --- a/src/Futhark/Internalise/AccurateSizes.hs +++ b/src/Futhark/Internalise/AccurateSizes.hs @@ -47,7 +47,7 @@ let addShape name = case M.lookup name mapping of Just se -> se - _ -> intConst Int64 0 -- FIXME: we only need this because + _ -> intConst Int32 0 -- FIXME: we only need this because -- the defunctionaliser throws away -- sizes. return $ map addShape shapes @@ -156,4 +156,4 @@ | otherwise = return v where checkDim desired has = - letSubExp "dim_match" $ BasicOp $ CmpOp (CmpEq int64) desired has + letSubExp "dim_match" $ BasicOp $ CmpOp (CmpEq int32) desired has diff --git a/src/Futhark/Internalise/Bindings.hs b/src/Futhark/Internalise/Bindings.hs --- a/src/Futhark/Internalise/Bindings.hs +++ b/src/Futhark/Internalise/Bindings.hs @@ -32,7 +32,7 @@ let num_param_idents = map length flattened_params num_param_ts = map (sum . map length) $ chunks num_param_idents params_ts - let shape_params = [I.Param v $ I.Prim I.int64 | E.TypeParamDim v _ <- tparams] + let shape_params = [I.Param v $ I.Prim I.int32 | E.TypeParamDim v _ <- tparams] shape_subst = M.fromList [(I.paramName p, [I.Var $ I.paramName p]) | p <- shape_params] bindingFlatPattern params_idents (concat params_ts) $ \valueparams -> I.localScope (I.scopeOfFParams $ shape_params ++ concat valueparams) $ @@ -49,7 +49,7 @@ pat_idents <- flattenPattern pat pat_ts <- internaliseLoopParamType (E.patternStructType pat) - let shape_params = [I.Param v $ I.Prim I.int64 | E.TypeParamDim v _ <- tparams] + let shape_params = [I.Param v $ I.Prim I.int32 | E.TypeParamDim v _ <- tparams] shape_subst = M.fromList [(I.paramName p, [I.Var $ I.paramName p]) | p <- shape_params] bindingFlatPattern pat_idents pat_ts $ \valueparams -> diff --git a/src/Futhark/Internalise/Defunctionalise.hs b/src/Futhark/Internalise/Defunctionalise.hs --- a/src/Futhark/Internalise/Defunctionalise.hs +++ b/src/Futhark/Internalise/Defunctionalise.hs @@ -126,7 +126,7 @@ | baseTag x <= maxIntrinsicTag -> return IntrinsicSV | otherwise -> -- Anything not in scope is going to be an -- existential size. - return $ Dynamic $ Scalar $ Prim $ Signed Int64 + return $ Dynamic $ Scalar $ Prim $ Signed Int32 | otherwise -> error $ "Variable " ++ pretty x ++ " at " @@ -842,7 +842,7 @@ ++ "." envFromDimNames :: [VName] -> Env -envFromDimNames = M.fromList . flip zip (repeat $ Dynamic $ Scalar $ Prim $ Signed Int64) +envFromDimNames = M.fromList . flip zip (repeat $ Dynamic $ Scalar $ Prim $ Signed Int32) -- | Create a new top-level value declaration with the given function name, -- return type, list of parameters, and body expression. diff --git a/src/Futhark/Internalise/Lambdas.hs b/src/Futhark/Internalise/Lambdas.hs --- a/src/Futhark/Internalise/Lambdas.hs +++ b/src/Futhark/Internalise/Lambdas.hs @@ -44,12 +44,12 @@ InternaliseM I.Lambda internaliseStreamMapLambda internaliseLambda lam args = do chunk_size <- newVName "chunk_size" - let chunk_param = I.Param chunk_size (I.Prim int64) + let chunk_param = I.Param chunk_size (I.Prim int32) outer = (`setOuterSize` I.Var chunk_size) localScope (scopeOfLParams [chunk_param]) $ do argtypes <- mapM I.subExpType args (lam_params, orig_body, rettype) <- - internaliseLambda lam $ I.Prim int64 : map outer argtypes + internaliseLambda lam $ I.Prim int32 : map outer argtypes let orig_chunk_param : params = lam_params body <- runBodyBinder $ do letBindNames [paramName orig_chunk_param] $ I.BasicOp $ I.SubExp $ I.Var chunk_size @@ -96,11 +96,11 @@ InternaliseM ([LParam], Body) internaliseStreamLambda internaliseLambda lam rowts = do chunk_size <- newVName "chunk_size" - let chunk_param = I.Param chunk_size $ I.Prim int64 + let chunk_param = I.Param chunk_size $ I.Prim int32 chunktypes = map (`arrayOfRow` I.Var chunk_size) rowts localScope (scopeOfLParams [chunk_param]) $ do (lam_params, orig_body, _) <- - internaliseLambda lam $ I.Prim int64 : chunktypes + internaliseLambda lam $ I.Prim int32 : chunktypes let orig_chunk_param : params = lam_params body <- runBodyBinder $ do letBindNames [paramName orig_chunk_param] $ I.BasicOp $ I.SubExp $ I.Var chunk_size @@ -126,19 +126,19 @@ lambdaWithIncrement body return $ I.Lambda params body' rettype where - rettype = replicate (k + 2) $ I.Prim int64 + rettype = replicate (k + 2) $ I.Prim int32 result i = map constant $ - fromIntegral i : - (replicate i 0 ++ [1 :: Int64] ++ replicate (k - i) 0) + (fromIntegral i :: Int32) : + (replicate i 0 ++ [1 :: Int32] ++ replicate (k - i) 0) mkResult _ i | i >= k = return $ result i mkResult eq_class i = do is_i <- letSubExp "is_i" $ BasicOp $ - CmpOp (CmpEq int64) eq_class $ - intConst Int64 $ toInteger i + CmpOp (CmpEq int32) eq_class $ + intConst Int32 $ toInteger i fmap (map I.Var) . letTupExp "part_res" =<< eIf (eSubExp is_i) diff --git a/src/Futhark/Internalise/Monomorphise.hs b/src/Futhark/Internalise/Monomorphise.hs --- a/src/Futhark/Internalise/Monomorphise.hs +++ b/src/Futhark/Internalise/Monomorphise.hs @@ -44,8 +44,8 @@ import Language.Futhark.Traversals import Language.Futhark.TypeChecker.Types -i64 :: TypeBase dim als -i64 = Scalar $ Prim $ Signed Int64 +i32 :: TypeBase dim als +i32 = Scalar $ Prim $ Signed Int32 -- The monomorphization monad reads 'PolyBinding's and writes -- 'ValBind's. The 'TypeParam's in the 'ValBind's can only be size @@ -199,7 +199,7 @@ f size_arg (Info (Observe, Nothing)) - (Info (foldFunType (replicate i i64) (fromStruct t)), Info []) + (Info (foldFunType (replicate i i32) (fromStruct t)), Info []) loc ) @@ -212,7 +212,7 @@ (qualName fname') ( Info ( foldFunType - (map (const i64) size_args) + (map (const i32) size_args) (fromStruct t') ) ) @@ -569,7 +569,7 @@ noticeDims :: TypeBase (DimDecl VName) as -> MonoM () noticeDims = mapM_ notice . nestedDims where - notice (NamedDim v) = void $ transformFName mempty v i64 + notice (NamedDim v) = void $ transformFName mempty v i32 notice _ = return () -- Convert a collection of 'ValBind's to a nested sequence of let-bound, @@ -646,9 +646,9 @@ tparamArg dinst tp = case M.lookup (typeParamName tp) dinst of Just (NamedDim d) -> - Just $ Var d (Info i64) mempty + Just $ Var d (Info i32) mempty Just (ConstDim x) -> - Just $ Literal (SignedValue $ Int64Value $ fromIntegral x) mempty + Just $ Literal (SignedValue $ Int32Value $ fromIntegral x) mempty _ -> Nothing @@ -744,7 +744,7 @@ mapOnPatternType = pure . applySubst substs } - shapeParam tp = Id (typeParamName tp) (Info i64) $ srclocOf tp + shapeParam tp = Id (typeParamName tp) (Info i32) $ srclocOf tp toValBinding name' tparams' params'' rettype' body'' = ValBind diff --git a/src/Futhark/Internalise/TypesValues.hs b/src/Futhark/Internalise/TypesValues.hs --- a/src/Futhark/Internalise/TypesValues.hs +++ b/src/Futhark/Internalise/TypesValues.hs @@ -102,7 +102,7 @@ internaliseDim d = case d of E.AnyDim -> Ext <$> newId - E.ConstDim n -> return $ Free $ intConst I.Int64 $ toInteger n + E.ConstDim n -> return $ Free $ intConst I.Int32 $ toInteger n E.NamedDim name -> namedDim name where namedDim (E.QualName _ name) = do diff --git a/src/Futhark/Optimise/Fusion.hs b/src/Futhark/Optimise/Fusion.hs --- a/src/Futhark/Optimise/Fusion.hs +++ b/src/Futhark/Optimise/Fusion.hs @@ -690,7 +690,7 @@ (loop_params, loop_arrs) = unzip loop_vars chunk_size <- newVName "chunk_size" offset <- newVName "offset" - let chunk_param = Param chunk_size $ Prim int64 + let chunk_param = Param chunk_size $ Prim int32 offset_param = Param offset $ Prim $ IntType it acc_params <- forM merge_params $ \p -> @@ -719,7 +719,7 @@ [ pure $ DoLoop [] merge' (ForLoop j it (Futhark.Var chunk_size) []) loop_body, pure $ - BasicOp $ BinOp (Add Int64 OverflowUndef) (Futhark.Var offset) (Futhark.Var chunk_size) + BasicOp $ BinOp (Add Int32 OverflowUndef) (Futhark.Var offset) (Futhark.Var chunk_size) ] let lam = Lambda @@ -733,7 +733,7 @@ -- first element in the pattern, as we use the first element to -- identify the SOAC in the second phase of fusion. discard <- newVName "discard" - let discard_pe = PatElem discard $ Prim int64 + let discard_pe = PatElem discard $ Prim int32 fusionGatherStms fres @@ -805,8 +805,8 @@ fres' <- addNamesToInfusible fres $ freeIn form <> freeIn ctx <> freeIn val let form_idents = case form of - ForLoop i it _ loopvars -> - Ident i (Prim (IntType it)) : map (paramIdent . fst) loopvars + ForLoop i _ _ loopvars -> + Ident i (Prim int32) : map (paramIdent . fst) loopvars WhileLoop {} -> [] new_res <- diff --git a/src/Futhark/Optimise/Fusion/LoopKernel.hs b/src/Futhark/Optimise/Fusion/LoopKernel.hs --- a/src/Futhark/Optimise/Fusion/LoopKernel.hs +++ b/src/Futhark/Optimise/Fusion/LoopKernel.hs @@ -442,7 +442,7 @@ { lambdaParams = lambdaParams lam_c ++ lambdaParams lam_p, lambdaBody = body', lambdaReturnType = - replicate (c_num_buckets + p_num_buckets) (Prim int64) + replicate (c_num_buckets + p_num_buckets) (Prim int32) ++ drop c_num_buckets (lambdaReturnType lam_c) ++ drop p_num_buckets (lambdaReturnType lam_p) } @@ -844,7 +844,7 @@ SOAC.Reshape cs shape SOAC.:< ots' <- SOAC.viewf ots, all primType $ lambdaReturnType maplam = do let mapw' = case reverse $ newDims shape of - [] -> intConst Int64 0 + [] -> intConst Int32 0 d : _ -> d inputs' = map (SOAC.addTransform $ SOAC.ReshapeOuter cs shape) inps inputTypes = map SOAC.inputType inputs' diff --git a/src/Futhark/Optimise/Simplify/ClosedForm.hs b/src/Futhark/Optimise/Simplify/ClosedForm.hs --- a/src/Futhark/Optimise/Simplify/ClosedForm.hs +++ b/src/Futhark/Optimise/Simplify/ClosedForm.hs @@ -62,14 +62,14 @@ (patternNames pat) inputsize mempty - Int64 + Int32 knownBnds (map paramName (lambdaParams lam)) (lambdaBody lam) accs isEmpty <- newVName "fold_input_is_empty" letBindNames [isEmpty] $ - BasicOp $ CmpOp (CmpEq int64) inputsize (intConst Int64 0) + BasicOp $ CmpOp (CmpEq int32) inputsize (intConst Int32 0) letBind pat =<< ( If (Var isEmpty) <$> resultBodyM accs @@ -183,7 +183,7 @@ | v `nameIn` nonFree = M.lookup v knownBnds asFreeSubExp se = Just se - properIntSize Int64 = Just $ return size + properIntSize Int32 = Just $ return size properIntSize t = Just $ letSubExp "converted_size" $ diff --git a/src/Futhark/Optimise/Simplify/Rules.hs b/src/Futhark/Optimise/Simplify/Rules.hs --- a/src/Futhark/Optimise/Simplify/Rules.hs +++ b/src/Futhark/Optimise/Simplify/Rules.hs @@ -340,7 +340,7 @@ letExp "for_in_partial" $ BasicOp $ Index arr' $ - DimSlice (intConst Int64 0) w (intConst Int64 1) : slice' + DimSlice (intConst Int32 0) w (intConst Int32 1) : slice' return (Just (p, for_in_partial), mempty) SubExpResult cs se | all (notIndex . stmExp) x_stms -> do @@ -355,15 +355,16 @@ notIndex _ = True simplifyLoopVariables _ _ _ _ = Skip --- If a for-loop with no loop variables has a counter of type Int64, --- and the bound is just a constant or sign-extended integer of --- smaller type, then change the loop to iterate over the smaller type --- instead. We then move the sign extension inside the loop instead. --- This addresses loops of the form @for i in x.. TopDownRuleDoLoop lore -narrowLoopType vtable pat aux (ctx, val, ForLoop i Int64 n [], body) - | Just (n', it', cs) <- smallerType = +narrowLoopType vtable pat aux (ctx, val, ForLoop i it n [], body) + | Just (n', it', cs) <- smallerType, + it' < it = Simplify $ do i' <- newVName $ baseString i let form' = ForLoop i' it' n' [] @@ -408,7 +409,7 @@ letBindNames [paramName p] $ BasicOp $ Index arr $ - DimFix (intConst Int64 i) : fullSlice (paramType p) [] + DimFix (intConst Int32 i) : fullSlice (paramType p) [] -- Some of the sizes in the types here might be temporarily wrong -- until copy propagation fixes it up. @@ -752,7 +753,7 @@ `add` primExpFromSubExp (IntType to_it) i_offset' i_stride'' <- letSubExp "iota_offset" $ - BasicOp $ BinOp (Mul Int64 OverflowWrap) s i_stride' + BasicOp $ BinOp (Mul Int32 OverflowWrap) s i_stride' fmap (SubExpResult cs) $ letSubExp "slice_iota" $ BasicOp $ Iota i_n i_offset'' i_stride'' to_it @@ -762,8 +763,8 @@ | not $ or $ zipWith rotateAndSlice offsets inds -> Just $ do dims <- arrayDims <$> lookupType a let adjustI i o d = do - i_p_o <- letSubExp "i_p_o" $ BasicOp $ BinOp (Add Int64 OverflowWrap) i o - letSubExp "rot_i" (BasicOp $ BinOp (SMod Int64 Unsafe) i_p_o d) + i_p_o <- letSubExp "i_p_o" $ BasicOp $ BinOp (Add Int32 OverflowWrap) i o + letSubExp "rot_i" (BasicOp $ BinOp (SMod Int32 Unsafe) i_p_o d) adjust (DimFix i, o, d) = DimFix <$> adjustI i o d adjust (DimSlice i n s, o, d) = @@ -790,7 +791,7 @@ return $ IndexResult cs arr $ ds_inds' ++ rest_inds where index DimFix {} = Nothing - index (DimSlice _ n s) = Just (n, DimSlice (constant (0 :: Int64)) n s) + index (DimSlice _ n s) = Just (n, DimSlice (constant (0 :: Int32)) n s) Just (Rearrange perm src, cs) | rearrangeReach perm <= length (takeWhile isIndex inds) -> let inds' = rearrangeShape (rearrangeInverse perm) inds @@ -835,7 +836,7 @@ xs_lens <- mapM (fmap (arraySize d) . lookupType) xs let add n m = do - added <- letSubExp "index_concat_add" $ BasicOp $ BinOp (Add Int64 OverflowWrap) n m + added <- letSubExp "index_concat_add" $ BasicOp $ BinOp (Add Int32 OverflowWrap) n m return (added, n) (_, starts) <- mapAccumLM add x_len xs_lens let xs_and_starts = reverse $ zip xs starts @@ -843,9 +844,9 @@ let mkBranch [] = letSubExp "index_concat" $ BasicOp $ Index x $ ibef ++ DimFix i : iaft mkBranch ((x', start) : xs_and_starts') = do - cmp <- letSubExp "index_concat_cmp" $ BasicOp $ CmpOp (CmpSle Int64) start i + cmp <- letSubExp "index_concat_cmp" $ BasicOp $ CmpOp (CmpSle Int32) start i (thisres, thisbnds) <- collectStms $ do - i' <- letSubExp "index_concat_i" $ BasicOp $ BinOp (Sub Int64 OverflowWrap) i start + i' <- letSubExp "index_concat_i" $ BasicOp $ BinOp (Sub Int32 OverflowWrap) i start letSubExp "index_concat" $ BasicOp $ Index x' $ ibef ++ DimFix i' : iaft thisbody <- mkBodyM thisbnds [thisres] (altres, altbnds) <- collectStms $ mkBranch xs_and_starts' @@ -855,7 +856,7 @@ IfDec [primBodyType res_t] IfNormal SubExpResult cs <$> mkBranch xs_and_starts Just (ArrayLit ses _, cs) - | DimFix (Constant (IntValue (Int64Value i))) : inds' <- inds, + | DimFix (Constant (IntValue (Int32Value i))) : inds' <- inds, Just se <- maybeNth i ses -> case inds' of [] -> Just $ pure $ SubExpResult cs se @@ -870,7 +871,7 @@ Just $ pure $ IndexResult mempty idd $ - DimFix (constant (0 :: Int64)) : inds' + DimFix (constant (0 :: Int32)) : inds' _ -> Nothing where defOf v = do @@ -919,7 +920,7 @@ fromConcatArg elem_type (ArgReplicate ws se, cs) = do let elem_shape = arrayShape elem_type certifying cs $ do - w <- letSubExp "concat_rep_w" =<< toExp (sum $ map pe64 ws) + w <- letSubExp "concat_rep_w" =<< toExp (sum $ map pe32 ws) letExp "concat_rep" $ BasicOp $ Replicate (setDim 0 elem_shape w) se fromConcatArg _ (ArgVar v, _) = pure v @@ -1240,7 +1241,7 @@ ruleBasicOp vtable pat aux (Update src [DimSlice i n s] (Var v)) | isCt1 n, isCt1 s, - Just (ST.Indexed cs e) <- ST.index v [intConst Int64 0] vtable = + Just (ST.Indexed cs e) <- ST.index v [intConst Int32 0] vtable = Simplify $ do e' <- toSubExp "update_elem" e auxing aux $ @@ -1329,7 +1330,7 @@ ruleBasicOp _ pat _ (ArrayLit (se : ses) _) | all (== se) ses = Simplify $ - let n = constant (fromIntegral (length ses) + 1 :: Int64) + let n = constant (fromIntegral (length ses) + 1 :: Int32) in letBind pat $ BasicOp $ Replicate (Shape [n]) se ruleBasicOp vtable pat aux (Index idd slice) | Just inds <- sliceIndices slice, @@ -1346,9 +1347,9 @@ oldshape <- arrayDims <$> lookupType idd2 let new_inds = reshapeIndex - (map pe64 oldshape) - (map pe64 $ newDims newshape) - (map pe64 inds) + (map pe32 oldshape) + (map pe32 $ newDims newshape) + (map pe32 inds) new_inds' <- mapM (toSubExp "new_index") new_inds certifying idd_cs $ @@ -1399,7 +1400,7 @@ | Just (BasicOp (Rearrange perm v2), v_cs) <- ST.lookupExp v vtable, Just (BasicOp (Rotate offsets2 v3), v2_cs) <- ST.lookupExp v2 vtable = Simplify $ do let offsets2' = rearrangeShape (rearrangeInverse perm) offsets2 - addOffsets x y = letSubExp "summed_offset" $ BasicOp $ BinOp (Add Int64 OverflowWrap) x y + addOffsets x y = letSubExp "summed_offset" $ BasicOp $ BinOp (Add Int32 OverflowWrap) x y offsets' <- zipWithM addOffsets offsets offsets2' rotate_rearrange <- auxing aux $ letExp "rotate_rearrange" $ BasicOp $ Rearrange perm v3 @@ -1414,7 +1415,7 @@ auxing aux $ letBind pat $ BasicOp $ Rotate offsets v2 where - add x y = letSubExp "offset" $ BasicOp $ BinOp (Add Int64 OverflowWrap) x y + add x y = letSubExp "offset" $ BasicOp $ BinOp (Add Int32 OverflowWrap) x y -- If we see an Update with a scalar where the value to be written is -- the result of indexing some other array, then we convert it into an @@ -1429,8 +1430,8 @@ arr_y /= arr_x, Just (slice_x_bef, DimFix i, []) <- focusNth (length slice_x - 1) slice_x, Just (slice_y_bef, DimFix j, []) <- focusNth (length slice_y - 1) slice_y = Simplify $ do - let slice_x' = slice_x_bef ++ [DimSlice i (intConst Int64 1) (intConst Int64 1)] - slice_y' = slice_y_bef ++ [DimSlice j (intConst Int64 1) (intConst Int64 1)] + let slice_x' = slice_x_bef ++ [DimSlice i (intConst Int32 1) (intConst Int32 1)] + slice_y' = slice_y_bef ++ [DimSlice j (intConst Int32 1) (intConst Int32 1)] v' <- letExp (baseString v ++ "_slice") $ BasicOp $ Index arr_y slice_y' certifying cs_y $ auxing aux $ @@ -1438,7 +1439,7 @@ -- Simplify away 0<=i when 'i' is from a loop of form 'for i < n'. ruleBasicOp vtable pat aux (CmpOp CmpSle {} x y) - | Constant (IntValue (Int64Value 0)) <- x, + | Constant (IntValue (Int32Value 0)) <- x, Var v <- y, Just _ <- ST.lookupLoopVar v vtable = Simplify $ auxing aux $ letBind pat $ BasicOp $ SubExp $ constant True diff --git a/src/Futhark/Optimise/TileLoops.hs b/src/Futhark/Optimise/TileLoops.hs --- a/src/Futhark/Optimise/TileLoops.hs +++ b/src/Futhark/Optimise/TileLoops.hs @@ -611,7 +611,7 @@ <*> pure (Var mergeinit) tile_id <- newVName "tile_id" - let loopform = ForLoop tile_id Int64 num_whole_tiles [] + let loopform = ForLoop tile_id Int32 num_whole_tiles [] loopbody <- renameBody <=< runBodyBinder $ inScopeOf loopform $ localScope (scopeOfFParams $ map fst merge) $ do @@ -661,7 +661,7 @@ tileReturns :: [(VName, SubExp)] -> [(SubExp, SubExp)] -> VName -> Binder Kernels KernelResult tileReturns dims_on_top dims arr = do - let unit_dims = replicate (length dims_on_top) (intConst Int64 1) + let unit_dims = replicate (length dims_on_top) (intConst Int32 1) arr' <- if null dims_on_top then return arr @@ -694,6 +694,9 @@ SegOp $ SegMap lvl space ts $ KernelBody () stms' $ map (Returns manifest) res' +v32 :: VName -> TPrimExp Int32 VName +v32 v = TPrimExp $ LeafExp v int32 + reconstructGtids1D :: Count GroupSize SubExp -> VName -> @@ -702,7 +705,7 @@ Binder Kernels () reconstructGtids1D group_size gtid gid ltid = letBindNames [gtid] - =<< toExp (le64 gid * pe64 (unCount group_size) + le64 ltid) + =<< toExp (v32 gid * pe32 (unCount group_size) + v32 ltid) readTile1D :: SubExp -> @@ -728,7 +731,7 @@ segMap1D "full_tile" (SegThread num_groups group_size SegNoVirt) ResultNoSimplify $ \ltid -> do j <- letSubExp "j" - =<< toExp (pe64 tile_id * pe64 tile_size + le64 ltid) + =<< toExp (pe32 tile_id * pe32 tile_size + v32 ltid) reconstructGtids1D group_size gtid gid ltid addPrivStms [DimFix $ Var ltid] privstms @@ -746,7 +749,7 @@ TilePartial -> letTupExp "pre" =<< eIf - (toExp $ pe64 j .<. pe64 w) + (toExp $ pe32 j .<. pe32 w) (resultBody <$> mapM (fmap Var . readTileElem) arrs) (eBody $ map eBlank tile_ts) TileFull -> @@ -795,7 +798,7 @@ fmap (map Var) $ letTupExp "acc" =<< eIf - (toExp $ le64 gtid .<. pe64 kdim) + (toExp $ v32 gtid .<. pe32 kdim) (eBody [pure $ Op $ OtherOp $ Screma tile_size form' tile]) (resultBodyM thread_accs) @@ -834,11 +837,11 @@ -- the whole tiles. residual_input <- letSubExp "residual_input" $ - BasicOp $ BinOp (SRem Int64 Unsafe) w tile_size + BasicOp $ BinOp (SRem Int32 Unsafe) w tile_size letTupExp "acc_after_residual" =<< eIf - (toExp $ pe64 residual_input .==. 0) + (toExp $ pe32 residual_input .==. 0) (resultBodyM $ map Var accs) (nonemptyTile residual_input) where @@ -861,7 +864,7 @@ BasicOp $ Index tile - [DimSlice (intConst Int64 0) residual_input (intConst Int64 1)] + [DimSlice (intConst Int32 0) residual_input (intConst Int32 1)] -- Now each thread performs a traversal of the tile and -- updates its accumulator. @@ -895,16 +898,16 @@ else do group_size <- letSubExp "computed_group_size" $ - BasicOp $ BinOp (SMin Int64) (unCount (segGroupSize initial_lvl)) kdim + BasicOp $ BinOp (SMin Int32) (unCount (segGroupSize initial_lvl)) kdim -- How many groups we need to exhaust the innermost dimension. ldim <- letSubExp "ldim" $ - BasicOp $ BinOp (SDivUp Int64 Unsafe) kdim group_size + BasicOp $ BinOp (SDivUp Int32 Unsafe) kdim group_size num_groups <- letSubExp "computed_num_groups" - =<< foldBinOp (Mul Int64 OverflowUndef) ldim (map snd dims_on_top) + =<< foldBinOp (Mul Int32 OverflowUndef) ldim (map snd dims_on_top) return ( SegGroup (Count num_groups) (Count group_size) SegNoVirt, @@ -916,8 +919,8 @@ Tiling { tilingSegMap = \desc lvl' manifest f -> segMap1D desc lvl' manifest $ \ltid -> do letBindNames [gtid] - =<< toExp (le64 gid * pe64 tile_size + le64 ltid) - f (untyped $ le64 gtid .<. pe64 kdim) [DimFix $ Var ltid], + =<< toExp (v32 gid * pe32 tile_size + v32 ltid) + f (untyped $ v32 gtid .<. pe32 kdim) [DimFix $ Var ltid], tilingReadTile = readTile1D tile_size gid gtid (segNumGroups lvl) (segGroupSize lvl), tilingProcessTile = @@ -928,7 +931,7 @@ tilingTileShape = Shape [tile_size], tilingNumWholeTiles = letSubExp "num_whole_tiles" $ - BasicOp $ BinOp (SQuot Int64 Unsafe) w tile_size, + BasicOp $ BinOp (SQuot Int32 Unsafe) w tile_size, tilingLevel = lvl, tilingSpace = space } @@ -984,9 +987,9 @@ reconstructGtids2D tile_size (gtid_x, gtid_y) (gid_x, gid_y) (ltid_x, ltid_y) = do -- Reconstruct the original gtids from gid_x/gid_y and ltid_x/ltid_y. letBindNames [gtid_x] - =<< toExp (le64 gid_x * pe64 tile_size + le64 ltid_x) + =<< toExp (v32 gid_x * pe32 tile_size + v32 ltid_x) letBindNames [gtid_y] - =<< toExp (le64 gid_y * pe64 tile_size + le64 ltid_y) + =<< toExp (v32 gid_y * pe32 tile_size + v32 ltid_y) readTile2D :: (SubExp, SubExp) -> @@ -1009,10 +1012,10 @@ $ \(ltid_x, ltid_y) -> do i <- letSubExp "i" - =<< toExp (pe64 tile_id * pe64 tile_size + le64 ltid_x) + =<< toExp (pe32 tile_id * pe32 tile_size + v32 ltid_x) j <- letSubExp "j" - =<< toExp (pe64 tile_id * pe64 tile_size + le64 ltid_y) + =<< toExp (pe32 tile_id * pe32 tile_size + v32 ltid_y) reconstructGtids2D tile_size (gtid_x, gtid_y) (gid_x, gid_y) (ltid_x, ltid_y) addPrivStms [DimFix $ Var ltid_x, DimFix $ Var ltid_y] privstms @@ -1035,11 +1038,11 @@ last $ rearrangeShape perm - [ le64 gtid_y .<. pe64 kdim_y, - le64 gtid_x .<. pe64 kdim_x + [ isInt32 (LeafExp gtid_y int32) .<. pe32 kdim_y, + isInt32 (LeafExp gtid_x int32) .<. pe32 kdim_x ] eIf - (toExp $ pe64 idx .<. pe64 w .&&. othercheck) + (toExp $ pe32 idx .<. pe32 w .&&. othercheck) (eBody [return $ BasicOp $ Index arr [DimFix idx]]) (eBody [eBlank tile_t]) @@ -1110,7 +1113,9 @@ fmap (map Var) $ letTupExp "acc" =<< eIf - ( toExp $ le64 gtid_x .<. pe64 kdim_x .&&. le64 gtid_y .<. pe64 kdim_y + ( toExp $ + isInt32 (LeafExp gtid_x int32) .<. pe32 kdim_x + .&&. isInt32 (LeafExp gtid_y int32) .<. pe32 kdim_y ) (eBody [pure $ Op $ OtherOp $ Screma actual_tile_size form' tiles']) (resultBodyM thread_accs) @@ -1150,11 +1155,11 @@ -- the whole tiles. residual_input <- letSubExp "residual_input" $ - BasicOp $ BinOp (SRem Int64 Unsafe) w tile_size + BasicOp $ BinOp (SRem Int32 Unsafe) w tile_size letTupExp "acc_after_residual" =<< eIf - (toExp $ pe64 residual_input .==. 0) + (toExp $ pe32 residual_input .==. 0) (resultBodyM $ map Var accs) (nonemptyTile residual_input) where @@ -1179,8 +1184,8 @@ BasicOp $ Index tile - [ DimSlice (intConst Int64 0) residual_input (intConst Int64 1), - DimSlice (intConst Int64 0) residual_input (intConst Int64 1) + [ DimSlice (intConst Int32 0) residual_input (intConst Int32 1), + DimSlice (intConst Int32 0) residual_input (intConst Int32 1) ] -- Now each thread performs a traversal of the tile and @@ -1207,19 +1212,19 @@ tile_size_key <- nameFromString . pretty <$> newVName "tile_size" tile_size <- letSubExp "tile_size" $ Op $ SizeOp $ GetSize tile_size_key SizeTile - group_size <- letSubExp "group_size" $ BasicOp $ BinOp (Mul Int64 OverflowUndef) tile_size tile_size + group_size <- letSubExp "group_size" $ BasicOp $ BinOp (Mul Int32 OverflowUndef) tile_size tile_size num_groups_x <- letSubExp "num_groups_x" $ - BasicOp $ BinOp (SDivUp Int64 Unsafe) kdim_x tile_size + BasicOp $ BinOp (SDivUp Int32 Unsafe) kdim_x tile_size num_groups_y <- letSubExp "num_groups_y" $ - BasicOp $ BinOp (SDivUp Int64 Unsafe) kdim_y tile_size + BasicOp $ BinOp (SDivUp Int32 Unsafe) kdim_y tile_size num_groups <- letSubExp "num_groups_top" =<< foldBinOp - (Mul Int64 OverflowUndef) + (Mul Int32 OverflowUndef) num_groups_x (num_groups_y : map snd dims_on_top) @@ -1236,8 +1241,8 @@ reconstructGtids2D tile_size (gtid_x, gtid_y) (gid_x, gid_y) (ltid_x, ltid_y) f ( untyped $ - le64 gtid_x .<. pe64 kdim_x - .&&. le64 gtid_y .<. pe64 kdim_y + isInt32 (LeafExp gtid_x int32) .<. pe32 kdim_x + .&&. isInt32 (LeafExp gtid_y int32) .<. pe32 kdim_y ) [DimFix $ Var ltid_x, DimFix $ Var ltid_y], tilingReadTile = readTile2D (kdim_x, kdim_y) (gtid_x, gtid_y) (gid_x, gid_y) tile_size (segNumGroups lvl) (segGroupSize lvl), @@ -1247,7 +1252,7 @@ tilingTileShape = Shape [tile_size, tile_size], tilingNumWholeTiles = letSubExp "num_whole_tiles" $ - BasicOp $ BinOp (SQuot Int64 Unsafe) w tile_size, + BasicOp $ BinOp (SQuot Int32 Unsafe) w tile_size, tilingLevel = lvl, tilingSpace = space } diff --git a/src/Futhark/Optimise/Unstream.hs b/src/Futhark/Optimise/Unstream.hs --- a/src/Futhark/Optimise/Unstream.hs +++ b/src/Futhark/Optimise/Unstream.hs @@ -75,7 +75,7 @@ | sequentialise stage soac = do stms <- runBinder_ $ FOT.transformSOAC pat soac fmap concat $ localScope (scopeOf stms) $ mapM (optimiseStm stage) $ stmsToList stms - | otherwise = + | otherwise = do -- Still sequentialise whatever's inside. pure <$> (Let pat aux . Op . OtherOp <$> mapSOACM optimise soac) where diff --git a/src/Futhark/Pass/ExpandAllocations.hs b/src/Futhark/Pass/ExpandAllocations.hs --- a/src/Futhark/Pass/ExpandAllocations.hs +++ b/src/Futhark/Pass/ExpandAllocations.hs @@ -212,19 +212,24 @@ Extraction -> ExpandM (RebaseMap, Stms KernelsMem) memoryRequirements lvl space kstms variant_allocs invariant_allocs = do - (num_threads, num_threads_stms) <- - runBinder $ + ((num_threads, num_groups64, num_threads64), num_threads_stms) <- runBinder $ do + num_threads <- letSubExp "num_threads" $ BasicOp $ BinOp - (Mul Int64 OverflowUndef) + (Mul Int32 OverflowUndef) (unCount $ segNumGroups lvl) (unCount $ segGroupSize lvl) + num_groups64 <- + letSubExp "num_groups64" $ + BasicOp $ ConvOp (SExt Int32 Int64) (unCount $ segNumGroups lvl) + num_threads64 <- letSubExp "num_threads64" $ BasicOp $ ConvOp (SExt Int32 Int64) num_threads + return (num_threads, num_groups64, num_threads64) (invariant_alloc_stms, invariant_alloc_offsets) <- inScopeOf num_threads_stms $ expandedInvariantAllocations - (num_threads, segNumGroups lvl, segGroupSize lvl) + (num_threads64, num_groups64, segNumGroups lvl, segGroupSize lvl) space invariant_allocs @@ -351,6 +356,7 @@ expandedInvariantAllocations :: ( SubExp, + SubExp, Count NumGroups SubExp, Count GroupSize SubExp ) -> @@ -358,7 +364,8 @@ Extraction -> ExpandM (Stms KernelsMem, RebaseMap) expandedInvariantAllocations - ( num_threads, + ( num_threads64, + num_groups64, Count num_groups, Count group_size ) @@ -375,8 +382,8 @@ let sizepat = Pattern [] [PatElem total_size $ MemPrim int64] allocpat = Pattern [] [PatElem mem $ MemMem space] num_users = case lvl of - SegThread {} -> num_threads - SegGroup {} -> num_groups + SegThread {} -> num_threads64 + SegGroup {} -> num_groups64 return ( stmsFromList [ Let sizepat (defAux ()) $ @@ -395,20 +402,21 @@ root_ixfun = IxFun.iota ( old_shape - ++ [ pe64 num_groups * pe64 group_size + ++ [ pe32 num_groups + * pe32 group_size ] ) permuted_ixfun = IxFun.permute root_ixfun perm offset_ixfun = IxFun.slice permuted_ixfun $ - DimFix (le64 (segFlat segspace)) : + DimFix (le32 (segFlat segspace)) : map untouched old_shape in offset_ixfun newBase SegGroup {} (old_shape, _) = - let root_ixfun = IxFun.iota (pe64 num_groups : old_shape) + let root_ixfun = IxFun.iota (pe32 num_groups : old_shape) offset_ixfun = IxFun.slice root_ixfun $ - DimFix (le64 (segFlat segspace)) : + DimFix (le32 (segFlat segspace)) : map untouched old_shape in offset_ixfun @@ -455,14 +463,15 @@ M.singleton mem $ newBase offset ) - num_threads' = pe64 num_threads - gtid = le64 $ segFlat kspace + num_threads' = pe32 num_threads + gtid = isInt32 $ LeafExp (segFlat kspace) int32 -- For the variant allocations, we add an inner dimension, -- which is then offset by a thread-specific amount. newBase size_per_thread (old_shape, pt) = let elems_per_thread = - pe64 size_per_thread `quot` primByteSize pt + isInt32 (sExt Int32 (primExpFromSubExp int64 size_per_thread)) + `quot` primByteSize pt root_ixfun = IxFun.iota [elems_per_thread, num_threads'] offset_ixfun = IxFun.slice @@ -477,7 +486,7 @@ in IxFun.reshape offset_ixfun shapechange -- | A map from memory block names to new index function bases. -type RebaseMap = M.Map VName (([TPrimExp Int64 VName], PrimType) -> IxFun) +type RebaseMap = M.Map VName (([TPrimExp Int32 VName], PrimType) -> IxFun) newtype OffsetM a = OffsetM @@ -502,7 +511,7 @@ askRebaseMap :: OffsetM RebaseMap askRebaseMap = OffsetM $ lift ask -lookupNewBase :: VName -> ([TPrimExp Int64 VName], PrimType) -> OffsetM (Maybe IxFun) +lookupNewBase :: VName -> ([TPrimExp Int32 VName], PrimType) -> OffsetM (Maybe IxFun) lookupNewBase name x = do offsets <- askRebaseMap return $ ($ x) <$> M.lookup name offsets @@ -745,7 +754,7 @@ letSubExp "z" $ BasicOp $ BinOp (SMax Int64) (Var $ paramName x) (Var $ paramName y) return $ Lambda (xs ++ ys) (mkBody stms zs) i64s - flat_gtid_lparam <- Param <$> newVName "flat_gtid" <*> pure (Prim (IntType Int64)) + flat_gtid_lparam <- Param <$> newVName "flat_gtid" <*> pure (Prim (IntType Int32)) (size_lam', _) <- flip runBinderT kernels_scope $ do params <- replicateM num_sizes $ newParam "x" (Prim int64) @@ -760,8 +769,8 @@ let (kspace_gtids, kspace_dims) = unzip $ unSegSpace space new_inds = unflattenIndex - (map pe64 kspace_dims) - (pe64 $ Var $ paramName flat_gtid_lparam) + (map pe32 kspace_dims) + (pe32 $ Var $ paramName flat_gtid_lparam) zipWithM_ letBindNames (map pure kspace_gtids) =<< mapM toExp new_inds mapM_ addStm kstms' @@ -771,6 +780,10 @@ Kernels.simplifyLambda (Lambda [flat_gtid_lparam] (Body () stms zs) i64s) ((maxes_per_thread, size_sums), slice_stms) <- flip runBinderT kernels_scope $ do + num_threads_64 <- + letSubExp "num_threads" $ + BasicOp $ ConvOp (SExt Int32 Int64) num_threads + pat <- basicPattern [] <$> replicateM @@ -779,12 +792,12 @@ w <- letSubExp "size_slice_w" - =<< foldBinOp (Mul Int64 OverflowUndef) (intConst Int64 1) (segSpaceDims space) + =<< foldBinOp (Mul Int32 OverflowUndef) (intConst Int32 1) (segSpaceDims space) thread_space_iota <- letExp "thread_space_iota" $ BasicOp $ - Iota w (intConst Int64 0) (intConst Int64 1) Int64 + Iota w (intConst Int32 0) (intConst Int32 1) Int32 let red_op = SegBinOp Commutative @@ -798,7 +811,7 @@ size_sums <- forM (patternNames pat) $ \threads_max -> letExp "size_sum" $ - BasicOp $ BinOp (Mul Int64 OverflowUndef) (Var threads_max) num_threads + BasicOp $ BinOp (Mul Int64 OverflowUndef) (Var threads_max) num_threads_64 return (patternNames pat, size_sums) diff --git a/src/Futhark/Pass/ExplicitAllocations.hs b/src/Futhark/Pass/ExplicitAllocations.hs --- a/src/Futhark/Pass/ExplicitAllocations.hs +++ b/src/Futhark/Pass/ExplicitAllocations.hs @@ -273,14 +273,14 @@ arraySizeInBytesExp :: Type -> PrimExp VName arraySizeInBytesExp t = - untyped $ foldl' (*) (elemSize t) $ map pe64 (arrayDims t) + untyped $ foldl' (*) (elemSize t) $ map (sExt64 . pe32) (arrayDims t) arraySizeInBytesExpM :: Allocator lore m => Type -> m (PrimExp VName) arraySizeInBytesExpM t = do dims <- mapM dimAllocationSize (arrayDims t) - let dim_prod_i64 = product $ map pe64 dims + let dim_prod_i32 = product $ map (sExt64 . pe32) dims elm_size_i64 = primByteSize $ elemType t - return $ untyped $ dim_prod_i64 * elm_size_i64 + return $ untyped $ dim_prod_i32 * elm_size_i64 arraySizeInBytes :: Allocator lore m => Type -> m SubExp arraySizeInBytes = computeSize "bytes" <=< arraySizeInBytesExpM @@ -330,7 +330,7 @@ [PatElem lore] ) allocsForPattern sizeidents validents rts hints = do - let sizes' = [PatElem size $ MemPrim int64 | size <- map identName sizeidents] + let sizes' = [PatElem size $ MemPrim int32 | size <- map identName sizeidents] (vals, (exts, mems)) <- runWriterT $ forM (zip3 validents rts hints) $ \(ident, rt, hint) -> do @@ -414,7 +414,7 @@ size_exts sizeidents substs = M.fromList $ new_substs <> size_substs - ixfn <- instantiateIxFun $ IxFun.substituteInIxFun (fmap isInt64 substs) ext_ixfn + ixfn <- instantiateIxFun $ IxFun.substituteInIxFun (fmap isInt32 substs) ext_ixfn return (patels, ixfn) @@ -446,8 +446,8 @@ computeSize "bytes" $ untyped $ product - [ product $ IxFun.base ixfun, - primByteSize (elemType t) + [ product $ map sExt64 $ IxFun.base ixfun, + fromIntegral (primByteSize (elemType t) :: Int64) ] m <- allocateMemory "mem" bytes space return $ MemArray bt (arrayShape t) NoUniqueness $ ArrayIn m ixfun @@ -461,7 +461,7 @@ directIxFun :: PrimType -> Shape -> u -> VName -> Type -> MemBound u directIxFun bt shape u mem t = - let ixf = IxFun.iota $ map pe64 $ arrayDims t + let ixf = IxFun.iota $ map pe32 $ arrayDims t in MemArray bt shape u $ ArrayIn mem ixf allocInFParams :: @@ -488,7 +488,7 @@ case paramDeclType param of Array bt shape u -> do let memname = baseString (paramName param) <> "_mem" - ixfun = IxFun.iota $ map pe64 $ shapeDims shape + ixfun = IxFun.iota $ map pe32 $ shapeDims shape mem <- lift $ newVName memname tell ([], [Param mem $ MemMem pspace]) return param {paramDec = MemArray bt shape u $ ArrayIn mem ixfun} @@ -541,8 +541,8 @@ ( \_ -> do vname <- lift $ newVName "ctx_param_ext" return - ( Param vname $ MemPrim int64, - fmap Free $ pe64 $ Var vname + ( Param vname $ MemPrim int32, + fmap Free $ pe32 $ Var vname ) ) substs @@ -573,7 +573,7 @@ (Allocable fromlore tolore, Allocator tolore (AllocM fromlore tolore)) => Space -> VName -> - AllocM fromlore tolore (SubExp, ExtIxFun, [TPrimExp Int64 VName], VName) + AllocM fromlore tolore (SubExp, ExtIxFun, [TPrimExp Int32 VName], VName) existentializeArray space v = do (mem', ixfun) <- lookupArraySummary v sp <- lookupMemSpace mem' @@ -604,7 +604,7 @@ <$> mapM ( \s -> do vname <- lift $ letExp "ctx_val" =<< toExp s - return (Var vname, fmap Free $ primExpFromSubExp int64 $ Var vname) + return (Var vname, fmap Free $ primExpFromSubExp int32 $ Var vname) ) substs @@ -726,8 +726,8 @@ ReturnsNewBlock DefaultSpace i $ IxFun.iota $ map convert $ shapeDims shape - convert (Ext i) = le64 $ Ext i - convert (Free v) = Free <$> pe64 v + convert (Ext i) = le32 $ Ext i + convert (Free v) = Free <$> pe32 v startOfFreeIDRange :: [TypeBase ExtShape u] -> Int startOfFreeIDRange = S.size . shapeContext @@ -877,7 +877,7 @@ generalize :: (Maybe Space, Maybe IxFun) -> (Maybe Space, Maybe IxFun) -> - (Maybe Space, Maybe (ExtIxFun, [(TPrimExp Int64 VName, TPrimExp Int64 VName)])) + (Maybe Space, Maybe (ExtIxFun, [(TPrimExp Int32 VName, TPrimExp Int32 VName)])) generalize (Just sp1, Just ixf1) (Just sp2, Just ixf2) = if sp1 /= sp2 then (Just sp1, Nothing) @@ -938,7 +938,7 @@ [ExtType] -> Body tolore -> [Maybe Space] -> - [Maybe (ExtIxFun, [TPrimExp Int64 VName])] -> + [Maybe (ExtIxFun, [TPrimExp Int32 VName])] -> AllocM fromlore tolore (Body tolore, [BodyReturns]) addResCtxInIfBody ifrets (Body _ bnds res) spaces substs = do let num_vals = length ifrets @@ -1006,8 +1006,8 @@ inspect (Prim pt) _ = MemPrim pt inspect (Mem space) _ = MemMem space - convert (Ext i) = le64 (Ext i) - convert (Free v) = Free <$> pe64 v + convert (Ext i) = le32 (Ext i) + convert (Free v) = Free <$> pe32 v adjustExtV :: Int -> Ext VName -> Ext VName adjustExtV _ (Free v) = Free v @@ -1050,10 +1050,10 @@ (mem, ixfun) <- lookupArraySummary a case paramType p of Array bt shape u -> do - dims <- map pe64 . arrayDims <$> lookupType a + dims <- map pe32 . arrayDims <$> lookupType a let ixfun' = IxFun.slice ixfun $ - fullSliceNum dims [DimFix $ le64 i] + fullSliceNum dims [DimFix $ le32 i] return (p {paramDec = MemArray bt shape u $ ArrayIn mem ixfun'}, a) Prim bt -> return (p {paramDec = MemPrim bt}, a) diff --git a/src/Futhark/Pass/ExplicitAllocations/Kernels.hs b/src/Futhark/Pass/ExplicitAllocations/Kernels.hs --- a/src/Futhark/Pass/ExplicitAllocations/Kernels.hs +++ b/src/Futhark/Pass/ExplicitAllocations/Kernels.hs @@ -49,7 +49,7 @@ letSubExp "num_threads" $ BasicOp $ BinOp - (Mul Int64 OverflowUndef) + (Mul Int32 OverflowUndef) (unCount (segNumGroups lvl)) (unCount (segGroupSize lvl)) allocAtLevel lvl $ mapSegOpM (mapper num_threads) op @@ -85,7 +85,7 @@ dims <- arrayDims <$> lookupType v let perm_inv = rearrangeInverse perm dims' = rearrangeShape perm dims - ixfun = IxFun.permute (IxFun.iota $ map pe64 dims') perm_inv + ixfun = IxFun.permute (IxFun.iota $ map pe32 dims') perm_inv return [Hint ixfun DefaultSpace] kernelExpHints (Op (Inner (SegOp (SegMap lvl@SegThread {} space ts body)))) = zipWithM (mapResultHint lvl space) ts $ kernelBodyResult body @@ -107,12 +107,12 @@ mapResultHint lvl space = hint where num_threads = - pe64 (unCount $ segNumGroups lvl) * pe64 (unCount $ segGroupSize lvl) + pe32 (unCount $ segNumGroups lvl) * pe32 (unCount $ segGroupSize lvl) -- Heuristic: do not rearrange for returned arrays that are -- sufficiently small. coalesceReturnOfShape _ [] = False - coalesceReturnOfShape bs [Constant (IntValue (Int64Value d))] = bs * d > 4 + coalesceReturnOfShape bs [Constant (IntValue (Int32Value d))] = bs * d > 4 coalesceReturnOfShape _ _ = True hint t Returns {} @@ -124,9 +124,9 @@ t_dims <- mapM dimAllocationSize $ arrayDims t return $ Hint (innermost [w] t_dims) DefaultSpace hint Prim {} (ConcatReturns SplitContiguous w elems_per_thread _) = do - let ixfun_base = IxFun.iota [sExt64 num_threads, pe64 elems_per_thread] + let ixfun_base = IxFun.iota [num_threads, pe32 elems_per_thread] ixfun_tr = IxFun.permute ixfun_base [1, 0] - ixfun = IxFun.reshape ixfun_tr $ map (DimNew . pe64) [w] + ixfun = IxFun.reshape ixfun_tr $ map (DimNew . pe32) [w] return $ Hint ixfun DefaultSpace hint _ _ = return NoHint @@ -139,7 +139,7 @@ ++ [0 .. length space_dims -1] perm_inv = rearrangeInverse perm dims_perm = rearrangeShape perm dims - ixfun_base = IxFun.iota $ map pe64 dims_perm + ixfun_base = IxFun.iota $ map pe32 dims_perm ixfun_rearranged = IxFun.permute ixfun_base perm_inv in ixfun_rearranged @@ -156,8 +156,8 @@ return $ if private r && all (semiStatic consts) (arrayDims t) then - let seg_dims = map pe64 $ segSpaceDims space - dims = seg_dims ++ map pe64 (arrayDims t) + let seg_dims = map pe32 $ segSpaceDims space + dims = seg_dims ++ map pe32 (arrayDims t) nilSlice d = DimSlice 0 d 0 in Hint ( IxFun.slice (IxFun.iota dims) $ @@ -178,7 +178,7 @@ maybePrivate consts t | Just (Array pt shape _) <- hasStaticShape t, all (semiStatic consts) $ shapeDims shape = do - let ixfun = IxFun.iota $ map pe64 $ shapeDims shape + let ixfun = IxFun.iota $ map pe32 $ shapeDims shape return $ Hint ixfun $ ScalarSpace (shapeDims shape) pt | otherwise = return NoHint diff --git a/src/Futhark/Pass/ExplicitAllocations/SegOp.hs b/src/Futhark/Pass/ExplicitAllocations/SegOp.hs --- a/src/Futhark/Pass/ExplicitAllocations/SegOp.hs +++ b/src/Futhark/Pass/ExplicitAllocations/SegOp.hs @@ -34,8 +34,8 @@ allocInBinOpParams :: Allocable fromlore tolore => SubExp -> - TPrimExp Int64 VName -> - TPrimExp Int64 VName -> + TPrimExp Int32 VName -> + TPrimExp Int32 VName -> [LParam fromlore] -> [LParam fromlore] -> AllocM fromlore tolore ([LParam tolore], [LParam tolore]) @@ -46,12 +46,12 @@ Array bt shape u -> do twice_num_threads <- letSubExp "twice_num_threads" $ - BasicOp $ BinOp (Mul Int64 OverflowUndef) num_threads $ intConst Int64 2 + BasicOp $ BinOp (Mul Int32 OverflowUndef) num_threads $ intConst Int32 2 let t = paramType x `arrayOfRow` twice_num_threads mem <- allocForArray t DefaultSpace -- XXX: this iota ixfun is a bit inefficient; leading to -- uncoalesced access. - let base_dims = map pe64 $ arrayDims t + let base_dims = map pe32 $ arrayDims t ixfun_base = IxFun.iota base_dims ixfun_x = IxFun.slice ixfun_base $ @@ -83,8 +83,8 @@ allocInBinOpLambda num_threads (SegSpace flat _) lam = do let (acc_params, arr_params) = splitAt (length (lambdaParams lam) `div` 2) $ lambdaParams lam - index_x = TPrimExp $ LeafExp flat int64 - index_y = index_x + pe64 num_threads + index_x = TPrimExp $ LeafExp flat int32 + index_y = index_x + pe32 num_threads (acc_params', arr_params') <- allocInBinOpParams num_threads index_x index_y acc_params arr_params diff --git a/src/Futhark/Pass/ExtractKernels.hs b/src/Futhark/Pass/ExtractKernels.hs --- a/src/Futhark/Pass/ExtractKernels.hs +++ b/src/Futhark/Pass/ExtractKernels.hs @@ -315,7 +315,7 @@ runBinder $ do to_what' <- letSubExp "comparatee" - =<< foldBinOp (Mul Int64 OverflowUndef) (intConst Int64 1) to_what + =<< foldBinOp (Mul Int32 OverflowUndef) (intConst Int32 1) to_what cmp_res <- letSubExp desc $ Op $ SizeOp $ CmpSizeLe size_key size_class to_what' return (cmp_res, size_key) @@ -594,7 +594,7 @@ String -> [SubExp] -> KernelPath -> - Maybe Int64 -> + Maybe Int32 -> DistribM ((SubExp, Name), Out.Stms Out.Kernels) sufficientParallelism desc ws path def = cmpSizeLe desc (Out.SizeThreshold path def) ws @@ -733,7 +733,7 @@ -- 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 :: Int64 +intraMinInnerPar :: Int32 intraMinInnerPar = 32 -- One NVIDIA warp onMap' :: @@ -796,7 +796,7 @@ fits <- letSubExp "fits" $ BasicOp $ - CmpOp (CmpSle Int64) group_size max_group_size + CmpOp (CmpSle Int32) group_size max_group_size addStms check_suff_stms diff --git a/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs b/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs --- a/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs +++ b/src/Futhark/Pass/ExtractKernels/BlockedKernel.hs @@ -135,10 +135,10 @@ -- device afterwards, as this may save an expensive -- host-device copy (scalars are kept on the host, but arrays -- may be on the device). - let addDummyDim t = t `arrayOfRow` intConst Int64 1 + let addDummyDim t = t `arrayOfRow` intConst Int32 1 pat' <- fmap addDummyDim <$> renamePattern pat dummy <- newVName "dummy" - let ispace = [(dummy, intConst Int64 1)] + let ispace = [(dummy, intConst Int32 1)] return ( pat', @@ -148,7 +148,7 @@ letBindNames [to] $ BasicOp $ Index from $ - fullSlice from_t [DimFix $ intConst Int64 0] + fullSlice from_t [DimFix $ intConst Int32 0] ) nonSegRed :: diff --git a/src/Futhark/Pass/ExtractKernels/DistributeNests.hs b/src/Futhark/Pass/ExtractKernels/DistributeNests.hs --- a/src/Futhark/Pass/ExtractKernels/DistributeNests.hs +++ b/src/Futhark/Pass/ExtractKernels/DistributeNests.hs @@ -580,7 +580,7 @@ return $ oneStm $ Let outerpat aux $ BasicOp $ Reshape reshape' arr maybeDistributeStm stm@(Let _ aux (BasicOp (Rotate rots _))) acc = distributeSingleUnaryStm acc stm $ \nest outerpat arr -> do - let rots' = map (const $ intConst Int64 0) (kernelNestWidths nest) ++ rots + let rots' = map (const $ intConst Int32 0) (kernelNestWidths nest) ++ rots return $ oneStm $ Let outerpat aux $ BasicOp $ Rotate rots' arr maybeDistributeStm stm@(Let pat aux (BasicOp (Update arr slice (Var v)))) acc | not $ null $ sliceDims slice = @@ -614,10 +614,10 @@ lam = Lambda { lambdaParams = [], - lambdaReturnType = [Prim int64, et], + lambdaReturnType = [Prim int32, et], lambdaBody = mkBody mempty [i, v] } - maybeDistributeStm (Let pat aux $ Op $ Scatter (intConst Int64 1) lam [] [(w, 1, arr)]) acc + maybeDistributeStm (Let pat aux $ Op $ Scatter (intConst Int32 1) lam [] [(w, 1, arr)]) acc where amortises DoLoop {} = True amortises Op {} = True @@ -839,7 +839,7 @@ letSubExp "v" $ BasicOp $ Index v $ map (DimFix . Var) slice_gtids slice_is <- traverse (toSubExp "index") $ - fixSlice (map (fmap pe64) slice) $ map (pe64 . Var) slice_gtids + fixSlice (map (fmap pe32) slice) $ map (pe32 . Var) slice_gtids let write_is = map (Var . fst) base_ispace ++ slice_is arr' = @@ -991,7 +991,7 @@ BasicOp $ Index ne_v $ fullSlice ne_v_t $ - replicate (shapeRank shape) $ DimFix $ intConst Int64 0 + replicate (shapeRank shape) $ DimFix $ intConst Int32 0 return (lam', nes', shape) Nothing -> return (lam, nes, mempty) diff --git a/src/Futhark/Pass/ExtractKernels/ISRWIM.hs b/src/Futhark/Pass/ExtractKernels/ISRWIM.hs --- a/src/Futhark/Pass/ExtractKernels/ISRWIM.hs +++ b/src/Futhark/Pass/ExtractKernels/ISRWIM.hs @@ -103,7 +103,7 @@ letSubExp "acc" $ BasicOp $ Index v $ - fullSlice v_t [DimFix $ intConst Int64 0] + fullSlice v_t [DimFix $ intConst Int32 0] indexAcc Constant {} = error "irwim: array accumulator is a constant." accs' <- mapM indexAcc accs diff --git a/src/Futhark/Pass/ExtractKernels/Intragroup.hs b/src/Futhark/Pass/ExtractKernels/Intragroup.hs --- a/src/Futhark/Pass/ExtractKernels/Intragroup.hs +++ b/src/Futhark/Pass/ExtractKernels/Intragroup.hs @@ -59,7 +59,7 @@ lift $ runBinder $ letSubExp "intra_num_groups" - =<< foldBinOp (Mul Int64 OverflowUndef) (intConst Int64 1) (map snd ispace) + =<< foldBinOp (Mul Int32 OverflowUndef) (intConst Int32 1) (map snd ispace) let body = lambdaBody lam @@ -82,18 +82,18 @@ ((intra_avail_par, kspace, read_input_stms), prelude_stms) <- lift $ runBinder $ do - let foldBinOp' _ [] = eSubExp $ intConst Int64 0 + let foldBinOp' _ [] = eSubExp $ intConst Int32 0 foldBinOp' bop (x : xs) = foldBinOp bop x xs ws_min <- - mapM (letSubExp "one_intra_par_min" <=< foldBinOp' (Mul Int64 OverflowUndef)) $ + mapM (letSubExp "one_intra_par_min" <=< foldBinOp' (Mul Int32 OverflowUndef)) $ filter (not . null) wss_min ws_avail <- - mapM (letSubExp "one_intra_par_avail" <=< foldBinOp' (Mul Int64 OverflowUndef)) $ + mapM (letSubExp "one_intra_par_avail" <=< foldBinOp' (Mul Int32 OverflowUndef)) $ filter (not . null) wss_avail -- The amount of parallelism available *in the worst case* is -- equal to the smallest parallel loop. - intra_avail_par <- letSubExp "intra_avail_par" =<< foldBinOp' (SMin Int64) ws_avail + intra_avail_par <- letSubExp "intra_avail_par" =<< foldBinOp' (SMin Int32) ws_avail -- The group size is either the maximum of the minimum parallelism -- exploited, or the desired parallelism (bounded by the max group @@ -102,10 +102,10 @@ =<< if null ws_min then eBinOp - (SMin Int64) + (SMin Int32) (eSubExp =<< letSubExp "max_group_size" (Op $ SizeOp $ Out.GetSizeMax Out.SizeGroup)) (eSubExp intra_avail_par) - else foldBinOp' (SMax Int64) ws_min + else foldBinOp' (SMax Int32) ws_min let inputIsUsed input = kernelInputName input `nameIn` freeIn body used_inps = filter inputIsUsed inps diff --git a/src/Futhark/Pass/ExtractKernels/StreamKernel.hs b/src/Futhark/Pass/ExtractKernels/StreamKernel.hs --- a/src/Futhark/Pass/ExtractKernels/StreamKernel.hs +++ b/src/Futhark/Pass/ExtractKernels/StreamKernel.hs @@ -48,14 +48,12 @@ SubExp -> SubExp -> m (SubExp, SubExp) -numberOfGroups desc w group_size = do +numberOfGroups desc w64 group_size = do max_num_groups_key <- nameFromString . pretty <$> newVName (desc ++ "_num_groups") num_groups <- letSubExp "num_groups" $ - Op $ SizeOp $ CalcNumGroups w max_num_groups_key group_size - num_threads <- - letSubExp "num_threads" $ - BasicOp $ BinOp (Mul Int64 OverflowUndef) num_groups group_size + Op $ SizeOp $ CalcNumGroups w64 max_num_groups_key group_size + num_threads <- letSubExp "num_threads" $ BasicOp $ BinOp (Mul Int32 OverflowUndef) num_groups group_size return (num_groups, num_threads) blockedKernelSize :: @@ -66,11 +64,12 @@ blockedKernelSize desc w = do group_size <- getSize (desc ++ "_group_size") SizeGroup - (_, num_threads) <- numberOfGroups desc w group_size + w64 <- letSubExp "w64" $ BasicOp $ ConvOp (SExt Int32 Int64) w + (_, num_threads) <- numberOfGroups desc w64 group_size per_thread_elements <- letSubExp "per_thread_elements" - =<< eBinOp (SDivUp Int64 Unsafe) (eSubExp w) (eSubExp num_threads) + =<< eBinOp (SDivUp Int64 Unsafe) (eSubExp w64) (toExp =<< asIntS Int64 num_threads) return $ KernelSize per_thread_elements num_threads @@ -88,13 +87,13 @@ letBindNames [chunk_size] $ Op $ SizeOp $ SplitSpace ordering w i elems_per_i case ordering of SplitContiguous -> do - offset <- letSubExp "slice_offset" $ BasicOp $ BinOp (Mul Int64 OverflowUndef) i elems_per_i + offset <- letSubExp "slice_offset" $ BasicOp $ BinOp (Mul Int32 OverflowUndef) i elems_per_i zipWithM_ (contiguousSlice offset) split_bound arrs SplitStrided stride -> zipWithM_ (stridedSlice stride) split_bound arrs where contiguousSlice offset slice_name arr = do arr_t <- lookupType arr - let slice = fullSlice arr_t [DimSlice offset (Var chunk_size) (constant (1 :: Int64))] + let slice = fullSlice arr_t [DimSlice offset (Var chunk_size) (constant (1 :: Int32))] letBindNames [slice_name] $ BasicOp $ Index arr slice stridedSlice stride slice_name arr = do @@ -133,7 +132,7 @@ red_ts = take num_nonconcat $ lambdaReturnType lam map_ts = map rowType $ drop num_nonconcat $ lambdaReturnType lam - per_thread <- asIntS Int64 $ kernelElementsPerThread kernel_size + per_thread <- asIntS Int32 $ kernelElementsPerThread kernel_size splitArrays (paramName chunk_size) (map paramName arr_params) @@ -215,6 +214,8 @@ fold_lam' <- kerneliseLambda nes fold_lam + elems_per_thread_32 <- asIntS Int32 elems_per_thread + gtid <- newVName "gtid" space <- mkSegSpace $ ispace ++ [(gtid, num_threads)] kbody <- fmap (uncurry (flip (KernelBody ()))) $ @@ -223,7 +224,7 @@ (chunk_red_pes, chunk_map_pes) <- blockedPerThread gtid w size ordering fold_lam' (length nes) arrs let concatReturns pe = - ConcatReturns split_ordering w elems_per_thread $ patElemName pe + ConcatReturns split_ordering w elems_per_thread_32 $ patElemName pe return ( map (Returns ResultMaySimplify . Var . patElemName) chunk_red_pes ++ map concatReturns chunk_map_pes @@ -303,20 +304,24 @@ -- array. segThreadCapped :: MonadFreshNames m => MkSegLevel Kernels m segThreadCapped ws desc r = do - w <- + w64 <- letSubExp "nest_size" - =<< foldBinOp (Mul Int64 OverflowUndef) (intConst Int64 1) ws + =<< foldBinOp (Mul Int64 OverflowUndef) (intConst Int64 1) + =<< mapM (asIntS Int64) ws group_size <- getSize (desc ++ "_group_size") SizeGroup case r of ManyThreads -> do usable_groups <- letSubExp "segmap_usable_groups" + . BasicOp + . ConvOp (SExt Int64 Int32) + =<< letSubExp "segmap_usable_groups_64" =<< eBinOp (SDivUp Int64 Unsafe) - (eSubExp w) + (eSubExp w64) (eSubExp =<< asIntS Int64 group_size) return $ SegThread (Count usable_groups) (Count group_size) SegNoVirt NoRecommendation v -> do - (num_groups, _) <- numberOfGroups desc w group_size + (num_groups, _) <- numberOfGroups desc w64 group_size return $ SegThread (Count num_groups) (Count group_size) v diff --git a/src/Futhark/Pass/KernelBabysitting.hs b/src/Futhark/Pass/KernelBabysitting.hs --- a/src/Futhark/Pass/KernelBabysitting.hs +++ b/src/Futhark/Pass/KernelBabysitting.hs @@ -118,7 +118,7 @@ letSubExp "num_threads" $ BasicOp $ BinOp - (Mul Int64 OverflowUndef) + (Mul Int32 OverflowUndef) (unCount $ segNumGroups lvl) (unCount $ segGroupSize lvl) evalStateT @@ -310,10 +310,11 @@ if null is then untyped $ pe32 num_threads else - untyped $ - product $ - map pe64 $ - drop (length is) thread_gdims + coerceIntPrimExp Int32 $ + untyped $ + product $ + map pe32 $ + drop (length is) thread_gdims replace =<< lift (rearrangeSlice (length is) (arraySize (length is) t) num_chunks arr) -- Everything is fine... assuming that the array is in row-major @@ -455,7 +456,7 @@ per_chunk <- letSubExp "per_chunk" $ - BasicOp $ BinOp (SQuot Int64 Unsafe) w_padded num_chunks' + BasicOp $ BinOp (SQuot Int32 Unsafe) w_padded num_chunks' arr_t <- lookupType arr arr_padded <- padArray w_padded padding arr_t rearrange num_chunks' w_padded per_chunk (baseString arr) arr_padded arr_t @@ -488,7 +489,7 @@ (map DimCoercion pre_dims ++ map DimNew (w_padded : post_dims)) arr_extradim_tr letExp (arr_name <> "_inv_tr_init") - =<< eSliceArray d arr_inv_tr (eSubExp $ constant (0 :: Int64)) (eSubExp w) + =<< eSliceArray d arr_inv_tr (eSubExp $ constant (0 :: Int32)) (eSubExp w) paddedScanReduceInput :: MonadBinder m => @@ -498,8 +499,8 @@ paddedScanReduceInput w stride = do w_padded <- letSubExp "padded_size" - =<< eRoundToMultipleOf Int64 (eSubExp w) (eSubExp stride) - padding <- letSubExp "padding" $ BasicOp $ BinOp (Sub Int64 OverflowUndef) w_padded w + =<< eRoundToMultipleOf Int32 (eSubExp w) (eSubExp stride) + padding <- letSubExp "padding" $ BasicOp $ BinOp (Sub Int32 OverflowUndef) w_padded w return (w_padded, padding) --- Computing variance. diff --git a/src/Futhark/Transform/FirstOrderTransform.hs b/src/Futhark/Transform/FirstOrderTransform.hs --- a/src/Futhark/Transform/FirstOrderTransform.hs +++ b/src/Futhark/Transform/FirstOrderTransform.hs @@ -142,7 +142,7 @@ zip mapout_params $ map Var map_arrs ] i <- newVName "i" - let loopform = ForLoop i Int64 w [] + let loopform = ForLoop i Int32 w [] loop_body <- runBodyBinder $ localScope (scopeOfFParams $ map fst merge) $ @@ -220,10 +220,10 @@ i <- newVName "i" - let loop_form = ForLoop i Int64 w [] + let loop_form = ForLoop i Int32 w [] letBindNames [paramName chunk_size_param] $ - BasicOp $ SubExp $ intConst Int64 1 + BasicOp $ SubExp $ intConst Int32 1 loop_body <- runBodyBinder $ localScope @@ -232,7 +232,7 @@ ) $ do let slice = - [DimSlice (Var i) (Var (paramName chunk_size_param)) (intConst Int64 1)] + [DimSlice (Var i) (Var (paramName chunk_size_param)) (intConst Int32 1)] forM_ (zip chunk_params arrs) $ \(p, arr) -> letBindNames [paramName p] $ BasicOp $ @@ -265,7 +265,7 @@ let merge = loopMerge asOuts $ map Var as_vs loopBody <- runBodyBinder $ localScope - ( M.insert iter (IndexName Int64) $ + ( M.insert iter (IndexName Int32) $ scopeOfFParams $ map fst merge ) $ do @@ -283,7 +283,7 @@ foldM saveInArray arr $ zip indexes' values' return $ resultBody (map Var ress) - letBind pat $ DoLoop [] merge (ForLoop iter Int64 len []) loopBody + letBind pat $ DoLoop [] merge (ForLoop iter Int32 len []) loopBody transformSOAC pat (Hist len ops bucket_fun imgs) = do iter <- newVName "iter" @@ -295,7 +295,7 @@ -- Bind lambda-bodies for operators. loopBody <- runBodyBinder $ localScope - ( M.insert iter (IndexName Int64) $ + ( M.insert iter (IndexName Int32) $ scopeOfFParams $ map fst merge ) $ do @@ -345,7 +345,7 @@ return $ resultBody $ map Var $ concat hists_out'' -- Wrap up the above into a for-loop. - letBind pat $ DoLoop [] merge (ForLoop iter Int64 len []) loopBody + letBind pat $ DoLoop [] merge (ForLoop iter Int32 len []) loopBody -- | Recursively first-order-transform a lambda. transformLambda :: diff --git a/src/Futhark/TypeCheck.hs b/src/Futhark/TypeCheck.hs --- a/src/Futhark/TypeCheck.hs +++ b/src/Futhark/TypeCheck.hs @@ -810,17 +810,17 @@ require [Prim (elemType src_t) `arrayOfShape` Shape (sliceDims idxes)] se consume =<< lookupAliases src checkBasicOp (Iota e x s et) = do - require [Prim int64] e + require [Prim int32] e require [Prim $ IntType et] x require [Prim $ IntType et] s checkBasicOp (Replicate (Shape dims) valexp) = do - mapM_ (require [Prim int64]) dims + mapM_ (require [Prim int32]) dims void $ checkSubExp valexp checkBasicOp (Scratch _ shape) = mapM_ checkSubExp shape checkBasicOp (Reshape newshape arrexp) = do rank <- arrayRank <$> checkArrIdent arrexp - mapM_ (require [Prim int64] . newDim) newshape + mapM_ (require [Prim int32] . newDim) newshape zipWithM_ (checkDimChange rank) newshape [0 ..] where checkDimChange _ (DimNew _) _ = @@ -845,7 +845,7 @@ checkBasicOp (Rotate rots arr) = do arrt <- lookupType arr let rank = arrayRank arrt - mapM_ (require [Prim int64]) rots + mapM_ (require [Prim int32]) rots when (length rots /= rank) $ bad $ TypeError $ @@ -870,7 +870,7 @@ ++ pretty arr1t ++ " and " ++ intercalate ", " (map pretty arr2ts) - require [Prim int64] ressize + require [Prim int32] ressize checkBasicOp (Copy e) = void $ checkArrIdent e checkBasicOp (Manifest perm arr) = @@ -1052,7 +1052,7 @@ Checkable lore => TypeBase Shape u -> TypeM lore () -checkType (Mem (ScalarSpace d _)) = mapM_ (require [Prim int64]) d +checkType (Mem (ScalarSpace d _)) = mapM_ (require [Prim int32]) d checkType t = mapM_ checkSubExp $ arrayDims t checkExtType :: @@ -1104,8 +1104,8 @@ Checkable lore => DimIndex SubExp -> TypeM lore () -checkDimIndex (DimFix i) = require [Prim int64] i -checkDimIndex (DimSlice i n s) = mapM_ (require [Prim int64]) [i, n, s] +checkDimIndex (DimFix i) = require [Prim int32] i +checkDimIndex (DimSlice i n s) = mapM_ (require [Prim int32]) [i, n, s] checkStm :: Checkable lore => @@ -1197,7 +1197,7 @@ let ctx_vals = zip ctx_res ctx_ts instantiateExt i = case maybeNth i ctx_vals of - Just (se, Prim (IntType Int64)) -> return se + Just (se, Prim (IntType Int32)) -> return se _ -> problem rettype' <- instantiateShapes instantiateExt rettype diff --git a/src/Language/Futhark/Interpreter.hs b/src/Language/Futhark/Interpreter.hs --- a/src/Language/Futhark/Interpreter.hs +++ b/src/Language/Futhark/Interpreter.hs @@ -80,7 +80,7 @@ type Stack = [StackFrame] -type Sizes = M.Map VName Int64 +type Sizes = M.Map VName Int32 -- | The monad in which evaluation takes place. newtype EvalM a @@ -119,14 +119,14 @@ lookupImport :: FilePath -> EvalM (Maybe Env) lookupImport f = asks $ M.lookup f . snd -putExtSize :: VName -> Int64 -> EvalM () +putExtSize :: VName -> Int32 -> EvalM () putExtSize v x = modify $ M.insert v x getSizes :: EvalM Sizes getSizes = get extSizeEnv :: EvalM Env -extSizeEnv = i64Env <$> getSizes +extSizeEnv = i32Env <$> getSizes prettyRecord :: Pretty a => M.Map Name a -> Doc prettyRecord m @@ -149,7 +149,7 @@ | ShapeSum (M.Map Name [Shape d]) deriving (Eq, Show, Functor, Foldable, Traversable) -type ValueShape = Shape Int64 +type ValueShape = Shape Int32 instance Pretty d => Pretty (Shape d) where ppr ShapeLeaf = mempty @@ -180,7 +180,7 @@ go _ = ShapeLeaf -structTypeShape :: M.Map VName ValueShape -> StructType -> Shape (Maybe Int64) +structTypeShape :: M.Map VName ValueShape -> StructType -> Shape (Maybe Int32) structTypeShape shapes = fmap dim . typeShape shapes' where dim (ConstDim d) = Just $ fromIntegral d @@ -212,10 +212,10 @@ matchDims (NamedDim (QualName _ d1)) (ConstDim d2) | d1 `elem` names = - i64Env $ M.singleton d1 $ fromIntegral d2 + i32Env $ M.singleton d1 $ fromIntegral d2 matchDims _ _ = mempty -resolveExistentials :: [VName] -> StructType -> ValueShape -> M.Map VName Int64 +resolveExistentials :: [VName] -> StructType -> ValueShape -> M.Map VName Int32 resolveExistentials names = match where match (Scalar (Record poly_fields)) (ShapeRecord fields) = @@ -273,7 +273,7 @@ valueShape (ValueSum shape _ _) = shape valueShape _ = ShapeLeaf -checkShape :: Shape (Maybe Int64) -> ValueShape -> Maybe ValueShape +checkShape :: Shape (Maybe Int32) -> ValueShape -> Maybe ValueShape checkShape (ShapeDim Nothing shape1) (ShapeDim d2 shape2) = ShapeDim d2 <$> checkShape shape1 shape2 checkShape (ShapeDim (Just d1) shape1) (ShapeDim d2 shape2) = do @@ -312,7 +312,7 @@ -- | Create an array value; failing if that would result in an -- irregular array. -mkArray :: TypeBase Int64 () -> [Value] -> Maybe Value +mkArray :: TypeBase Int32 () -> [Value] -> Maybe Value mkArray t [] = return $ toArray (typeShape mempty t) [] mkArray _ (v : vs) = do @@ -343,8 +343,8 @@ asSigned (ValuePrim (SignedValue v)) = v asSigned v = error $ "Unexpected not a signed integer: " ++ pretty v -asInt64 :: Value -> Int64 -asInt64 = fromIntegral . asInteger +asInt32 :: Value -> Int32 +asInt32 = fromIntegral . asInteger asBool :: Value -> Bool asBool (ValuePrim (BoolValue x)) = x @@ -427,12 +427,12 @@ where tbind = T.TypeAbbr Unlifted [] -i64Env :: M.Map VName Int64 -> Env -i64Env = valEnv . M.map f +i32Env :: M.Map VName Int32 -> Env +i32Env = valEnv . M.map f where f x = - ( Just $ T.BoundV [] $ Scalar $ Prim $ Signed Int64, - ValuePrim $ SignedValue $ Int64Value x + ( Just $ T.BoundV [] $ Scalar $ Prim $ Signed Int32, + ValuePrim $ SignedValue $ Int32Value x ) instance Show InterpreterError where @@ -531,8 +531,8 @@ patternMatch _ _ _ = mzero data Indexing - = IndexingFix Int64 - | IndexingSlice (Maybe Int64) (Maybe Int64) (Maybe Int64) + = IndexingFix Int32 + | IndexingSlice (Maybe Int32) (Maybe Int32) (Maybe Int32) instance Pretty Indexing where ppr (IndexingFix i) = ppr i @@ -549,10 +549,10 @@ maybe mempty ppr i <> text ":" indexesFor :: - Maybe Int64 -> - Maybe Int64 -> - Maybe Int64 -> - Int64 -> + Maybe Int32 -> + Maybe Int32 -> + Maybe Int32 -> + Int32 -> Maybe [Int] indexesFor start end stride n | (start', end', stride') <- slice, @@ -633,11 +633,11 @@ evalDimIndex :: Env -> DimIndex -> EvalM Indexing evalDimIndex env (DimFix x) = - IndexingFix . asInt64 <$> eval env x + IndexingFix . asInt32 <$> eval env x evalDimIndex env (DimSlice start end stride) = - IndexingSlice <$> traverse (fmap asInt64 . eval env) start - <*> traverse (fmap asInt64 . eval env) end - <*> traverse (fmap asInt64 . eval env) stride + IndexingSlice <$> traverse (fmap asInt32 . eval env) start + <*> traverse (fmap asInt32 . eval env) end + <*> traverse (fmap asInt32 . eval env) stride evalIndex :: SrcLoc -> Env -> [Indexing] -> Value -> EvalM Value evalIndex loc env is arr = do @@ -663,7 +663,7 @@ in arrayOf et' shape' u where evalDim (NamedDim qn) - | Just (TermValue _ (ValuePrim (SignedValue (Int64Value x)))) <- + | Just (TermValue _ (ValuePrim (SignedValue (Int32Value x)))) <- lookupVar qn env = ConstDim $ fromIntegral x evalDim d = d @@ -735,7 +735,7 @@ | null missing_sizes = env' | otherwise = env' - <> i64Env + <> i32Env ( resolveExistentials missing_sizes (patternStructType p) @@ -779,7 +779,7 @@ evalArg env e ext = do v <- eval env e case ext of - Just ext' -> putExtSize ext' $ asInt64 v + Just ext' -> putExtSize ext' $ asInt32 v Nothing -> return () return v @@ -1030,7 +1030,7 @@ sparams (patternStructType pat) (valueShape v) - in matchPattern (i64Env sparams' <> env) pat v + in matchPattern (i32Env sparams' <> env) pat v inc = (`P.doAdd` Int64Value 1) zero = (`P.doMul` Int64Value 0) @@ -1044,7 +1044,7 @@ ( valEnv ( M.singleton iv - ( Just $ T.BoundV [] $ Scalar $ Prim $ Signed Int64, + ( Just $ T.BoundV [] $ Scalar $ Prim $ Signed Int32, ValuePrim (SignedValue i) ) ) @@ -1572,7 +1572,7 @@ toTuple [ toArray' rowshape $ concat parts, toArray' rowshape $ - map (ValuePrim . SignedValue . Int64Value . genericLength) parts + map (ValuePrim . SignedValue . Int32Value . genericLength) parts ] pack . map reverse @@ -1628,8 +1628,8 @@ def "unflatten" = Just $ fun3t $ \n m xs -> do let (ShapeDim _ innershape, xs') = fromArray xs - rowshape = ShapeDim (asInt64 m) innershape - shape = ShapeDim (asInt64 n) rowshape + rowshape = ShapeDim (asInt32 m) innershape + shape = ShapeDim (asInt32 n) rowshape return $ toArray shape $ map (toArray rowshape) $ chunk (asInt m) xs' def "opaque" = Just $ fun1 return def "trace" = Just $ fun1 $ \v -> trace v >> return v @@ -1645,7 +1645,7 @@ return $ T.TypeAbbr Unlifted [] $ Scalar $ Prim t stream f arg@(ValueArray _ xs) = - let n = ValuePrim $ SignedValue $ Int64Value $ arrayLength xs + let n = ValuePrim $ SignedValue $ Int32Value $ arrayLength xs in apply2 noLoc mempty f n arg stream _ arg = error $ "Cannot stream: " ++ pretty arg diff --git a/src/Language/Futhark/Parser/Parser.y b/src/Language/Futhark/Parser/Parser.y --- a/src/Language/Futhark/Parser/Parser.y +++ b/src/Language/Futhark/Parser/Parser.y @@ -974,7 +974,7 @@ | '[' ']' {% emptyArrayError $1 } -Dim :: { Int64 } +Dim :: { Int32 } Dim : intlit { let L _ (INTLIT num) = $1 in fromInteger num } ValueType :: { ValueType } diff --git a/src/Language/Futhark/Pretty.hs b/src/Language/Futhark/Pretty.hs --- a/src/Language/Futhark/Pretty.hs +++ b/src/Language/Futhark/Pretty.hs @@ -115,7 +115,7 @@ instance Pretty (ShapeDecl ()) where ppr (ShapeDecl ds) = mconcat $ replicate (length ds) $ text "[]" -instance Pretty (ShapeDecl Int64) where +instance Pretty (ShapeDecl Int32) where ppr (ShapeDecl ds) = mconcat (map (brackets . ppr) ds) instance Pretty (ShapeDecl Bool) where diff --git a/src/Language/Futhark/Prop.hs b/src/Language/Futhark/Prop.hs --- a/src/Language/Futhark/Prop.hs +++ b/src/Language/Futhark/Prop.hs @@ -821,8 +821,8 @@ ( "unflatten", IntrinsicPolyFun [tp_a] - [ Scalar $ Prim $ Signed Int64, - Scalar $ Prim $ Signed Int64, + [ Scalar $ Prim $ Signed Int32, + Scalar $ Prim $ Signed Int32, Array () Nonunique t_a (rank 1) ] $ Array () Nonunique t_a (rank 2) @@ -836,7 +836,7 @@ ( "rotate", IntrinsicPolyFun [tp_a] - [Scalar $ Prim $ Signed Int64, arr_a] + [Scalar $ Prim $ Signed Int32, arr_a] arr_a ), ("transpose", IntrinsicPolyFun [tp_a] [arr_2d_a] arr_2d_a), @@ -844,7 +844,7 @@ IntrinsicPolyFun [tp_a] [ Array () Unique t_a (rank 1), - Array () Nonunique (Prim $ Signed Int64) (rank 1), + Array () Nonunique (Prim $ Signed Int32) (rank 1), Array () Nonunique t_a (rank 1) ] $ Array () Unique t_a (rank 1) @@ -854,11 +854,11 @@ ( "hist", IntrinsicPolyFun [tp_a] - [ Scalar $ Prim $ Signed Int64, + [ Scalar $ Prim $ Signed Int32, uarr_a, Scalar t_a `arr` (Scalar t_a `arr` Scalar t_a), Scalar t_a, - Array () Nonunique (Prim $ Signed Int64) (rank 1), + Array () Nonunique (Prim $ Signed Int32) (rank 1), arr_a ] uarr_a @@ -886,28 +886,28 @@ IntrinsicPolyFun [tp_a] [ Scalar (Prim $ Signed Int32), - Scalar t_a `arr` Scalar (Prim $ Signed Int64), + Scalar t_a `arr` Scalar (Prim $ Signed Int32), arr_a ] - $ tupleRecord [uarr_a, Array () Unique (Prim $ Signed Int64) (rank 1)] + $ tupleRecord [uarr_a, Array () Unique (Prim $ Signed Int32) (rank 1)] ), ( "map_stream", IntrinsicPolyFun [tp_a, tp_b] - [Scalar (Prim $ Signed Int64) `karr` (arr_ka `arr` arr_kb), arr_a] + [Scalar (Prim $ Signed Int32) `karr` (arr_ka `arr` arr_kb), arr_a] uarr_b ), ( "map_stream_per", IntrinsicPolyFun [tp_a, tp_b] - [Scalar (Prim $ Signed Int64) `karr` (arr_ka `arr` arr_kb), arr_a] + [Scalar (Prim $ Signed Int32) `karr` (arr_ka `arr` arr_kb), arr_a] uarr_b ), ( "reduce_stream", IntrinsicPolyFun [tp_a, tp_b] [ Scalar t_b `arr` (Scalar t_b `arr` Scalar t_b), - Scalar (Prim $ Signed Int64) `karr` (arr_ka `arr` Scalar t_b), + Scalar (Prim $ Signed Int32) `karr` (arr_ka `arr` Scalar t_b), arr_a ] $ Scalar t_b @@ -916,7 +916,7 @@ IntrinsicPolyFun [tp_a, tp_b] [ Scalar t_b `arr` (Scalar t_b `arr` Scalar t_b), - Scalar (Prim $ Signed Int64) `karr` (arr_ka `arr` Scalar t_b), + Scalar (Prim $ Signed Int32) `karr` (arr_ka `arr` Scalar t_b), arr_a ] $ Scalar t_b diff --git a/src/Language/Futhark/Syntax.hs b/src/Language/Futhark/Syntax.hs --- a/src/Language/Futhark/Syntax.hs +++ b/src/Language/Futhark/Syntax.hs @@ -433,7 +433,7 @@ type StructType = TypeBase (DimDecl VName) () -- | A value type contains full, manifest size information. -type ValueType = TypeBase Int64 () +type ValueType = TypeBase Int32 () -- | A dimension declaration expression for use in a 'TypeExp'. data DimExp vn diff --git a/src/Language/Futhark/TypeChecker.hs b/src/Language/Futhark/TypeChecker.hs --- a/src/Language/Futhark/TypeChecker.hs +++ b/src/Language/Futhark/TypeChecker.hs @@ -181,7 +181,7 @@ typeParamEnv (TypeParamDim v _) = mempty { envVtable = - M.singleton v $ BoundV [] (Scalar $ Prim $ Signed Int64) + M.singleton v $ BoundV [] (Scalar $ Prim $ Signed Int32) } typeParamEnv (TypeParamType l v _) = mempty diff --git a/src/Language/Futhark/TypeChecker/Monad.hs b/src/Language/Futhark/TypeChecker/Monad.hs --- a/src/Language/Futhark/TypeChecker/Monad.hs +++ b/src/Language/Futhark/TypeChecker/Monad.hs @@ -220,10 +220,10 @@ checkNamedDim loc v = do (v', t) <- lookupVar loc v case t of - Scalar (Prim (Signed Int64)) -> return v' + Scalar (Prim (Signed Int32)) -> return v' _ -> typeError loc mempty $ - "Dimension declaration" <+> ppr v <+> "should be of type i64." + "Dimension declaration" <+> ppr v <+> "should be of type i32." typeError :: Located loc => loc -> Notes -> Doc -> m a diff --git a/src/Language/Futhark/TypeChecker/Terms.hs b/src/Language/Futhark/TypeChecker/Terms.hs --- a/src/Language/Futhark/TypeChecker/Terms.hs +++ b/src/Language/Futhark/TypeChecker/Terms.hs @@ -576,9 +576,9 @@ checkNamedDim loc v = do (v', t) <- lookupVar loc v - onFailure (CheckingRequired [Scalar $ Prim $ Signed Int64] (toStruct t)) $ + onFailure (CheckingRequired [Scalar $ Prim $ Signed Int32] (toStruct t)) $ unify (mkUsage loc "use as array size") (toStruct t) $ - Scalar $ Prim $ Signed Int64 + Scalar $ Prim $ Signed Int32 return v' typeError loc notes s = do @@ -635,7 +635,7 @@ return tdecl' where observeDim (NamedDim v) = - observe $ Ident (qualLeaf v) (Info $ Scalar $ Prim $ Signed Int64) mempty + observe $ Ident (qualLeaf v) (Info $ Scalar $ Prim $ Signed Int32) mempty observeDim _ = return () -- | Instantiate a type scheme with fresh type variables for its type @@ -983,7 +983,7 @@ typeParamIdent :: TypeParam -> Maybe Ident typeParamIdent (TypeParamDim v loc) = - Just $ Ident v (Info $ Scalar $ Prim $ Signed Int64) loc + Just $ Ident v (Info $ Scalar $ Prim $ Signed Int32) loc typeParamIdent _ = Nothing bindingIdent :: @@ -1086,13 +1086,13 @@ -- Pattern match some known slices to be non-existential. adjustDims (DimSlice i j stride : idxes') (_ : dims) | refine_sizes, - maybe True ((== Just 0) . isInt64) i, + maybe True ((== Just 0) . isInt32) i, Just j' <- maybeDimFromExp =<< j, - maybe True ((== Just 1) . isInt64) stride = + maybe True ((== Just 1) . isInt32) stride = (j' :) <$> adjustDims idxes' dims adjustDims (DimSlice Nothing Nothing stride : idxes') (d : dims) | refine_sizes, - maybe True (maybe False ((== 1) . abs) . isInt64) stride = + maybe True (maybe False ((== 1) . abs) . isInt32) stride = (d :) <$> adjustDims idxes' dims adjustDims (DimSlice i j stride : idxes') (d : dims) = (:) <$> sliceSize d i j stride <*> adjustDims idxes' dims @@ -1290,26 +1290,21 @@ Just <$> (unifies "use in range expression" start_t =<< checkExp step) let unifyRange e = unifies "use in range expression" start_t =<< checkExp e - end' <- traverse unifyRange end - - end_t <- case end' of - DownToExclusive e -> expType e - ToInclusive e -> expType e - UpToExclusive e -> expType e + end' <- case end of + DownToExclusive e -> DownToExclusive <$> unifyRange e + UpToExclusive e -> UpToExclusive <$> unifyRange e + ToInclusive e -> ToInclusive <$> unifyRange e -- Special case some ranges to give them a known size. let dimFromBound = dimFromExp (SourceBound . bareExp) (dim, retext) <- - case (isInt64 start', isInt64 <$> maybe_step', end') of - (Just 0, Just (Just 1), UpToExclusive end'') - | Scalar (Prim (Signed Int64)) <- end_t -> - dimFromBound end'' - (Just 0, Nothing, UpToExclusive end'') - | Scalar (Prim (Signed Int64)) <- end_t -> - dimFromBound end'' - (Just 1, Just (Just 2), ToInclusive end'') - | Scalar (Prim (Signed Int64)) <- end_t -> - dimFromBound end'' + case (isInt32 start', isInt32 <$> maybe_step', end') of + (Just 0, Just (Just 1), UpToExclusive end'') -> + dimFromBound end'' + (Just 0, Nothing, UpToExclusive end'') -> + dimFromBound end'' + (Just 1, Just (Just 2), ToInclusive end'') -> + dimFromBound end'' _ -> do d <- newDimVar loc (Rigid RigidRange) "range_dim" return (NamedDim $ qualName d, Just d) @@ -2287,7 +2282,7 @@ where check = maybe (return Nothing) $ - fmap Just . unifies "use as index" (Scalar $ Prim $ Signed Int64) <=< checkExp + fmap Just . unifies "use as index" (Scalar $ Prim $ Signed Int32) <=< checkExp sequentially :: TermTypeM a -> (a -> Occurences -> TermTypeM b) -> TermTypeM b sequentially m1 m2 = do @@ -2391,7 +2386,7 @@ return (tp1', tp2'', argext, ext) where - sizeSubst (Scalar (Prim (Signed Int64))) e = dimFromArg fname e + sizeSubst (Scalar (Prim (Signed Int32))) e = dimFromArg fname e sizeSubst _ _ = return (AnyDim, Nothing) checkApply loc fname tfun@(Scalar TypeVar {}) arg = do tv <- newTypeVar loc "b" @@ -2420,17 +2415,17 @@ | prev_applied == 1 = "argument" | otherwise = "arguments" -isInt64 :: Exp -> Maybe Int64 -isInt64 (Literal (SignedValue (Int64Value k')) _) = Just $ fromIntegral k' -isInt64 (IntLit k' _ _) = Just $ fromInteger k' -isInt64 (Negate x _) = negate <$> isInt64 x -isInt64 _ = Nothing +isInt32 :: Exp -> Maybe Int32 +isInt32 (Literal (SignedValue (Int32Value k')) _) = Just $ fromIntegral k' +isInt32 (IntLit k' _ _) = Just $ fromInteger k' +isInt32 (Negate x _) = negate <$> isInt32 x +isInt32 _ = Nothing maybeDimFromExp :: Exp -> Maybe (DimDecl VName) maybeDimFromExp (Var v _ _) = Just $ NamedDim v maybeDimFromExp (Parens e _) = maybeDimFromExp e maybeDimFromExp (QualParens _ e _) = maybeDimFromExp e -maybeDimFromExp e = ConstDim . fromIntegral <$> isInt64 e +maybeDimFromExp e = ConstDim . fromIntegral <$> isInt32 e dimFromExp :: (Exp -> SizeSource) -> Exp -> TermTypeM (DimDecl VName, Maybe VName) dimFromExp rf (Parens e _) = dimFromExp rf e