diff options
Diffstat (limited to 'ops/Data/Array/Strided/Arith/Internal.hs')
| -rw-r--r-- | ops/Data/Array/Strided/Arith/Internal.hs | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/ops/Data/Array/Strided/Arith/Internal.hs b/ops/Data/Array/Strided/Arith/Internal.hs index 313d72f..5802573 100644 --- a/ops/Data/Array/Strided/Arith/Internal.hs +++ b/ops/Data/Array/Strided/Arith/Internal.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} @@ -9,7 +10,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} module Data.Array.Strided.Arith.Internal where @@ -21,20 +21,20 @@ import Data.Int import Data.List (sort, zip4) import Data.Proxy import Data.Type.Equality -import qualified Data.Vector.Storable as VS -import qualified Data.Vector.Storable.Mutable as VSM +import Data.Vector.Storable qualified as VS +import Data.Vector.Storable.Mutable qualified as VSM import Foreign.C.Types import Foreign.Ptr import Foreign.Storable -import qualified GHC.TypeNats as TypeNats import GHC.TypeLits +import GHC.TypeNats qualified as TypeNats import Language.Haskell.TH import System.IO (hFlush, stdout) import System.IO.Unsafe -import Data.Array.Strided.Array -import Data.Array.Strided.Arith.Internal.Lists import Data.Array.Strided.Arith.Internal.Foreign +import Data.Array.Strided.Arith.Internal.Lists +import Data.Array.Strided.Array -- TODO: need to sort strides for reduction-like functions so that the C inner-loop specialisation has some chance of working even after transposition @@ -49,11 +49,11 @@ data Dict c where debugShow :: forall n a. (Storable a, KnownNat n) => Array n a -> String debugShow (Array sh strides offset vec) = - "Array @" ++ (show (natVal (Proxy @n))) ++ " " ++ show sh ++ " " ++ show strides ++ " " ++ show offset ++ " <_*" ++ show (VS.length vec) ++ ">" + "Array @" ++ show (natVal (Proxy @n)) ++ " " ++ show sh ++ " " ++ show strides ++ " " ++ show offset ++ " <_*" ++ show (VS.length vec) ++ ">" -- TODO: test all the cases of this thing with various input strides -liftOpEltwise1 :: (Storable a, Storable b) +liftOpEltwise1 :: Storable a => SNat n -> (Ptr a -> Ptr b) -> (Int64 -> Ptr b -> Ptr Int64 -> Ptr Int64 -> Ptr b -> IO ()) @@ -62,7 +62,7 @@ liftOpEltwise1 sn@SNat ptrconv cf_strided arr@(Array sh strides offset vec) | Just (blockOff, blockSz) <- stridesDense sh offset strides = if blockSz == 0 then Array sh (map (const 0) strides) 0 VS.empty - else let resvec = arrValues $ wrapUnary sn ptrconv cf_strided (Array [fromIntegral blockSz] [1] blockOff vec) + else let resvec = arrValues $ wrapUnary sn ptrconv cf_strided (Array [blockSz] [1] blockOff vec) in Array sh strides (offset - blockOff) resvec | otherwise = wrapUnary sn ptrconv cf_strided arr @@ -174,8 +174,8 @@ unreplicateStrides (Array sh strides offset vec) = reinsertZeros (False : zeros) (s : strides') = s : reinsertZeros zeros strides' reinsertZeros (True : zeros) strides' = 0 : reinsertZeros zeros strides' reinsertZeros [] [] = [] - reinsertZeros (False : _) [] = error $ "unreplicateStrides: Internal error: reply strides too short" - reinsertZeros [] (_:_) = error $ "unreplicateStrides: Internal error: reply strides too long" + reinsertZeros (False : _) [] = error "unreplicateStrides: Internal error: reply strides too short" + reinsertZeros [] (_:_) = error "unreplicateStrides: Internal error: reply strides too long" unrepSize = product [n | (n, True) <- zip sh replDims] @@ -214,7 +214,7 @@ simplifyArray array k if | sh' /= init (arrShape array') -> error $ "simplifyArray: Internal error: reply shape wrong (reply " ++ show sh' ++ ", unreplicated " ++ show (arrShape array') ++ ")" | last (arrStrides array) == 0 -> - error $ "simplifyArray: Internal error: reduction reply handler used while inner stride was 0" + error "simplifyArray: Internal error: reduction reply handler used while inner stride was 0" | otherwise -> arrayRevDims (init revDims) (Array (init (arrShape array)) (init (rereplicate (strides' ++ [0]))) offset' vec')) @@ -253,8 +253,8 @@ simplifyArray2 arr1@(Array sh _ _ _) arr2@(Array sh2 _ _ _) k , let reinsertZeros (False : zeros) (s : strides') = s : reinsertZeros zeros strides' reinsertZeros (True : zeros) strides' = 0 : reinsertZeros zeros strides' reinsertZeros [] [] = [] - reinsertZeros (False : _) [] = error $ "simplifyArray2: Internal error: reply strides too short" - reinsertZeros [] (_:_) = error $ "simplifyArray2: Internal error: reply strides too long" + reinsertZeros (False : _) [] = error "simplifyArray2: Internal error: reply strides too short" + reinsertZeros [] (_:_) = error "simplifyArray2: Internal error: reply strides too long" , let unrepSize = product [n | (n, True) <- zip sh replDims] @@ -272,7 +272,7 @@ simplifyArray2 arr1@(Array sh _ _ _) arr2@(Array sh2 _ _ _) k if | sh' /= init shF -> error $ "simplifyArray2: Internal error: reply shape wrong (reply " ++ show sh' ++ ", unreplicated " ++ show shF ++ ")" | last replDims -> - error $ "simplifyArray2: Internal error: reduction reply handler used while inner dimension was unreplicated" + error "simplifyArray2: Internal error: reduction reply handler used while inner dimension was unreplicated" | otherwise -> arrayRevDims (init revDims) (Array (init sh) (reinsertZeros (init replDims) strides') offset' vec')) @@ -673,7 +673,7 @@ intWidBranchRedFull fsc fred32 fred64 sn | finiteBitSize (undefined :: i) == 64 = vectorRedFullOp @i @Int64 sn fsc fromIntegral castPtr fred64 | otherwise = error "Unsupported Int width" -intWidBranchExtr :: forall i n. (FiniteBits i, Storable i, Integral i) +intWidBranchExtr :: forall i n. (FiniteBits i, Storable i) => -- int32 (forall b. b ~ Int32 => Ptr Int64 -> Int64 -> Ptr Int64 -> Ptr Int64 -> Ptr b -> IO ()) -- ^ extremum kernel -- int64 |