aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bench/Main.hs18
-rw-r--r--ops/Data/Array/Strided/Arith/Internal.hs14
-rw-r--r--src/Data/Array/Mixed/Permutation.hs2
-rw-r--r--src/Data/Array/Mixed/Shape.hs2
-rw-r--r--src/Data/Array/Mixed/Types.hs2
-rw-r--r--src/Data/Array/Mixed/XArray.hs11
-rw-r--r--src/Data/Array/Nested/Internal/Mixed.hs4
-rw-r--r--src/Data/Array/Nested/Internal/Ranked.hs1
-rw-r--r--src/Data/Array/Nested/Internal/Shape.hs2
-rw-r--r--src/Data/Array/Nested/Internal/Shaped.hs3
-rw-r--r--test/Gen.hs3
-rw-r--r--test/Tests/C.hs14
-rw-r--r--test/Util.hs1
13 files changed, 36 insertions, 41 deletions
diff --git a/bench/Main.hs b/bench/Main.hs
index 7f4b4e3..45c1129 100644
--- a/bench/Main.hs
+++ b/bench/Main.hs
@@ -35,7 +35,7 @@ main = do
let enable = False
bracket (Arith.statisticsEnable enable)
(\() -> do Arith.statisticsEnable False
- when enable $ Arith.statisticsPrintAll)
+ when enable Arith.statisticsPrintAll)
(\() -> main_tests)
main_tests :: IO ()
@@ -97,17 +97,17 @@ main_tests = defaultMain
,bgroup "orthotope"
[bench "normalize [1e6]" $
let n = 1_000_000
- in nf (\a -> RS.normalize a)
+ in nf RS.normalize
(RS.rev [0] (RS.iota @Double n))
,bench "normalize noop [1e6]" $
let n = 1_000_000
- in nf (\a -> RS.normalize a)
+ in nf RS.normalize
(RS.rev [0] (RS.rev [0] (RS.iota @Double n)))
]
,bgroupIf enableMisc "misc"
[let n = 1000
k = 1000
- in bgroup ("fusion [" ++ show k ++ "]*" ++ show n) $
+ in bgroup ("fusion [" ++ show k ++ "]*" ++ show n)
[bench "sum (concat)" $
nf (\as -> VS.sum (VS.concat as))
(replicate n (VS.enumFromTo (1::Int) k))
@@ -120,14 +120,14 @@ main_tests = defaultMain
[bench ("LA.vjoin [500]*1e" ++ show ni) $
let n = 10 ^ ni
k = 500
- in nf (\as -> LA.vjoin as)
+ in nf LA.vjoin
(replicate n (VS.enumFromTo (1::Int) k))
| ni <- [1::Int ..5]]
,bgroup "vectorStorable"
[bench ("VS.concat [500]*1e" ++ show ni) $
let n = 10 ^ ni
k = 500
- in nf (\as -> VS.concat as)
+ in nf VS.concat
(replicate n (VS.enumFromTo (1::Int) k))
| ni <- [1::Int ..5]]
]
@@ -136,14 +136,14 @@ main_tests = defaultMain
[bench ("LA.vjoin [1e" ++ show ki ++ "]*500") $
let n = 500
k = 10 ^ ki
- in nf (\as -> LA.vjoin as)
+ in nf LA.vjoin
(replicate n (VS.enumFromTo (1::Int) k))
| ki <- [1::Int ..5]]
,bgroup "vectorStorable"
[bench ("VS.concat [1e" ++ show ki ++ "]*500") $
let n = 500
k = 10 ^ ki
- in nf (\as -> VS.concat as)
+ in nf VS.concat
(replicate n (VS.enumFromTo (1::Int) k))
| ki <- [1::Int ..5]]
]
@@ -230,7 +230,7 @@ tests_compare =
nf (\a -> LA.sumElements (sin a))
(LA.linspace @Double n (0.0, fromIntegral (n - 1)))
,bench "sum Double [1e6]" $
- nf (\a -> LA.sumElements a)
+ nf LA.sumElements
(LA.linspace @Double n (0.0, fromIntegral (n - 1)))
,bench "dotprod Float [1e6]" $
nf (\(a, b) -> a LA.<.> b)
diff --git a/ops/Data/Array/Strided/Arith/Internal.hs b/ops/Data/Array/Strided/Arith/Internal.hs
index 4d7e1da..95e5af2 100644
--- a/ops/Data/Array/Strided/Arith/Internal.hs
+++ b/ops/Data/Array/Strided/Arith/Internal.hs
@@ -49,7 +49,7 @@ 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
@@ -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'))
diff --git a/src/Data/Array/Mixed/Permutation.hs b/src/Data/Array/Mixed/Permutation.hs
index 8efcbe8..cedfa22 100644
--- a/src/Data/Array/Mixed/Permutation.hs
+++ b/src/Data/Array/Mixed/Permutation.hs
@@ -85,7 +85,7 @@ permCheckPermutation = \p k ->
provePerm1 :: Proxy isTop -> SNat (Rank isTop) -> Perm is'
-> Maybe (AllElem' is' (Count 0 (Rank isTop)) :~: True)
- provePerm1 _ _ PNil = Just (Refl)
+ provePerm1 _ _ PNil = Just Refl
provePerm1 p rtop@SNat (PCons sn@SNat perm)
| Just Refl <- provePerm1 p rtop perm
= case (cmpNat (SNat @0) sn, cmpNat sn rtop) of
diff --git a/src/Data/Array/Mixed/Shape.hs b/src/Data/Array/Mixed/Shape.hs
index 0b6d390..3f1f58e 100644
--- a/src/Data/Array/Mixed/Shape.hs
+++ b/src/Data/Array/Mixed/Shape.hs
@@ -557,7 +557,7 @@ instance (KnownNat n, KnownShX sh) => KnownShX (Just n : sh) where knownShX = SK
instance KnownShX sh => KnownShX (Nothing : sh) where knownShX = SUnknown () :!% knownShX
withKnownShX :: forall sh r. StaticShX sh -> (KnownShX sh => r) -> r
-withKnownShX sh = withDict @(KnownShX sh) sh
+withKnownShX = withDict @(KnownShX sh)
-- * Flattening
diff --git a/src/Data/Array/Mixed/Types.hs b/src/Data/Array/Mixed/Types.hs
index 3f5b1e7..e97690f 100644
--- a/src/Data/Array/Mixed/Types.hs
+++ b/src/Data/Array/Mixed/Types.hs
@@ -54,7 +54,7 @@ sameNat' :: SNat n -> SNat m -> Maybe (n :~: m)
sameNat' n@SNat m@SNat = sameNat n m
pattern SZ :: () => (n ~ 0) => SNat n
-pattern SZ <- ((\sn -> testEquality sn (SNat @0)) -> Just Refl)
+pattern SZ <- (\sn -> testEquality sn (SNat @0) -> Just Refl)
where SZ = SNat
pattern SS :: forall np1. () => forall n. (n + 1 ~ np1) => SNat n -> SNat np1
diff --git a/src/Data/Array/Mixed/XArray.hs b/src/Data/Array/Mixed/XArray.hs
index 3680930..681b8db 100644
--- a/src/Data/Array/Mixed/XArray.hs
+++ b/src/Data/Array/Mixed/XArray.hs
@@ -5,7 +5,6 @@
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
@@ -93,7 +92,7 @@ replicate sh ssh' (XArray arr)
, Dict <- lemKnownNatRankSSX (ssxAppend (ssxFromShape sh) ssh')
, Refl <- lemRankApp (ssxFromShape sh) ssh'
= XArray (S.stretch (shxToList sh ++ S.shapeL arr) $
- S.reshape (map (const 1) (shxToList sh) ++ S.shapeL arr) $
+ S.reshape (map (const 1) (shxToList sh) ++ S.shapeL arr)
arr)
replicateScal :: forall sh a. Storable a => IShX sh -> a -> XArray sh a
@@ -169,7 +168,7 @@ rerank :: forall sh sh1 sh2 a b.
rerank ssh ssh1 ssh2 f xarr@(XArray arr)
| Dict <- lemKnownNatRankSSX (ssxAppend ssh ssh2)
= let (sh, _) = shxSplitApp (Proxy @sh1) ssh (shape (ssxAppend ssh ssh1) xarr)
- in if any (== 0) (shxToList sh)
+ in if elem 0 (shxToList sh)
then XArray (S.fromList (shxToList (shxAppend sh (shxCompleteZeros ssh2))) [])
else case () of
() | Dict <- lemKnownNatRankSSX ssh
@@ -196,7 +195,7 @@ rerank2 :: forall sh sh1 sh2 a b c.
rerank2 ssh ssh1 ssh2 f xarr1@(XArray arr1) (XArray arr2)
| Dict <- lemKnownNatRankSSX (ssxAppend ssh ssh2)
= let (sh, _) = shxSplitApp (Proxy @sh1) ssh (shape (ssxAppend ssh ssh1) xarr1)
- in if any (== 0) (shxToList sh)
+ in if elem 0 (shxToList sh)
then XArray (S.fromList (shxToList (shxAppend sh (shxCompleteZeros ssh2))) [])
else case () of
() | Dict <- lemKnownNatRankSSX ssh
@@ -270,7 +269,7 @@ sumInner ssh ssh' arr
in go $
transpose2 ssh'F ssh $
reshapePartial ssh' ssh sh'F $
- transpose2 ssh ssh' $
+ transpose2 ssh ssh'
arr
sumOuter :: forall sh sh' a. (Storable a, NumElt a)
@@ -281,7 +280,7 @@ sumOuter ssh ssh' arr
shF = shxFlatten sh :$% ZSX
in sumInner ssh' (ssxFromShape shF) $
transpose2 (ssxFromShape shF) ssh' $
- reshapePartial ssh ssh' shF $
+ reshapePartial ssh ssh' shF
arr
fromListOuter :: forall n sh a. Storable a
diff --git a/src/Data/Array/Nested/Internal/Mixed.hs b/src/Data/Array/Nested/Internal/Mixed.hs
index 1d4181e..4271526 100644
--- a/src/Data/Array/Nested/Internal/Mixed.hs
+++ b/src/Data/Array/Nested/Internal/Mixed.hs
@@ -543,7 +543,7 @@ instance Elt a => Elt (Mixed sh' a) where
= fst (shxSplitApp (Proxy @sh') (ssxFromShape sh) (mshape arr))
mindex :: Mixed sh (Mixed sh' a) -> IIxX sh -> Mixed sh' a
- mindex (M_Nest _ arr) i = mindexPartial arr i
+ mindex (M_Nest _ arr) = mindexPartial arr
mindexPartial :: forall sh1 sh2.
Mixed (sh1 ++ sh2) (Mixed sh' a) -> IIxX sh1 -> Mixed sh2 (Mixed sh' a)
@@ -858,7 +858,7 @@ msliceU :: Elt a => Int -> Int -> Mixed (Nothing : sh) a -> Mixed (Nothing : sh)
msliceU i n arr = mlift (ssxFromShape (mshape arr)) (\_ -> X.sliceU i n) arr
mrev1 :: Elt a => Mixed (n : sh) a -> Mixed (n : sh) a
-mrev1 arr = mlift (ssxFromShape (mshape arr)) (\_ -> X.rev1) arr
+mrev1 arr = mlift (ssxFromShape (mshape arr)) (const X.rev1) arr
mreshape :: forall sh sh' a. Elt a => IShX sh' -> Mixed sh a -> Mixed sh' a
mreshape sh' arr =
diff --git a/src/Data/Array/Nested/Internal/Ranked.hs b/src/Data/Array/Nested/Internal/Ranked.hs
index 045b2ef..1d076e8 100644
--- a/src/Data/Array/Nested/Internal/Ranked.hs
+++ b/src/Data/Array/Nested/Internal/Ranked.hs
@@ -3,7 +3,6 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
diff --git a/src/Data/Array/Nested/Internal/Shape.hs b/src/Data/Array/Nested/Internal/Shape.hs
index e65164b..e9e0103 100644
--- a/src/Data/Array/Nested/Internal/Shape.hs
+++ b/src/Data/Array/Nested/Internal/Shape.hs
@@ -690,7 +690,7 @@ instance KnownShS '[] where knownShS = ZSS
instance (KnownNat n, KnownShS sh) => KnownShS (n : sh) where knownShS = natSing :$$ knownShS
withKnownShS :: forall sh r. ShS sh -> (KnownShS sh => r) -> r
-withKnownShS sh = withDict @(KnownShS sh) sh
+withKnownShS = withDict @(KnownShS sh)
shsKnownShS :: ShS sh -> Dict KnownShS sh
shsKnownShS ZSS = Dict
diff --git a/src/Data/Array/Nested/Internal/Shaped.hs b/src/Data/Array/Nested/Internal/Shaped.hs
index cd69daa..109fb70 100644
--- a/src/Data/Array/Nested/Internal/Shaped.hs
+++ b/src/Data/Array/Nested/Internal/Shaped.hs
@@ -3,7 +3,6 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
@@ -423,7 +422,7 @@ sslice i n@SNat arr =
in slift (n :$$ sh) (\_ -> X.slice i n) arr
srev1 :: Elt a => Shaped (n : sh) a -> Shaped (n : sh) a
-srev1 arr = slift (sshape arr) (\_ -> X.rev1) arr
+srev1 arr = slift (sshape arr) (const X.rev1) arr
sreshape :: (Elt a, Product sh ~ Product sh') => ShS sh' -> Shaped sh a -> Shaped sh' a
sreshape sh' (Shaped arr) = Shaped (mreshape (shCvtSX sh') arr)
diff --git a/test/Gen.hs b/test/Gen.hs
index 244c735..8099f0d 100644
--- a/test/Gen.hs
+++ b/test/Gen.hs
@@ -2,7 +2,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeAbstractions #-}
@@ -49,7 +48,7 @@ genLowBiased (lo, hi) = do
return (lo + x * x * x * (hi - lo))
shuffleShR :: IShR n -> Gen (IShR n)
-shuffleShR = \sh -> go (length (toList sh)) (toList sh) sh
+shuffleShR = \sh -> go (length sh) (toList sh) sh
where
go :: Int -> [Int] -> IShR n -> Gen (IShR n)
go _ _ ZSR = return ZSR
diff --git a/test/Tests/C.hs b/test/Tests/C.hs
index b10e66a..1480491 100644
--- a/test/Tests/C.hs
+++ b/test/Tests/C.hs
@@ -45,7 +45,7 @@ prop_sum_nonempty = property $ genRank $ \outrank@(SNat @n) -> do
let inrank = SNat @(n + 1)
sh <- forAll $ genShR inrank
-- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh))
- guard (all (> 0) (toList (shrTail sh))) -- only constrain the tail
+ guard (all (> 0) (shrTail sh)) -- only constrain the tail
arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList sh) <$>
genStorables (Range.singleton (product sh))
(\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
@@ -62,7 +62,7 @@ prop_sum_empty = property $ genRank $ \outrankm1@(SNat @nm1) -> do
sht <- shuffleShR (0 :$: shtt) -- n
n <- Gen.int (Range.linear 0 20)
return (n :$: sht) -- n + 1
- guard (any (== 0) (toList (shrTail sh)))
+ guard (elem 0 (toList (shrTail sh)))
-- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh))
let arr = OR.fromList @(n + 1) @Double (toList sh) []
let rarr = rfromOrthotope inrank arr
@@ -72,7 +72,7 @@ prop_sum_lasteq1 :: Property
prop_sum_lasteq1 = property $ genRank $ \outrank@(SNat @n) -> do
let inrank = SNat @(n + 1)
outsh <- forAll $ genShR outrank
- guard (all (> 0) (toList outsh))
+ guard (all (> 0) outsh)
let insh = shrAppend outsh (1 :$: ZSR)
arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList insh) <$>
genStorables (Range.singleton (product insh))
@@ -89,7 +89,7 @@ prop_sum_replicated doTranspose = property $
LTI -> return Refl -- actually we only continue if m < n
_ -> discard
(sh1, sh2, sh3) <- forAll $ genReplicatedShR inrank1 inrank2
- guard (all (> 0) (toList sh3))
+ guard (all (> 0) sh3)
arr <- forAllT $
OR.stretch (toList sh3)
. OR.reshape (toList sh2)
@@ -111,7 +111,7 @@ prop_negate_with :: forall f b. Show b
prop_negate_with genRank' genB preproc = property $
genRank' $ \extra rank@(SNat @n) -> do
sh <- forAll $ genShR rank
- guard (all (> 0) (toList sh))
+ guard (all (> 0) sh)
arr <- forAllT $ OR.fromVector @Double @n (toList sh) <$>
genStorables (Range.singleton (product sh))
(\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
@@ -140,7 +140,7 @@ tests = testGroup "C"
(\Refl (n :$: _) -> do lo <- Gen.integral (Range.constant 0 (n-1))
len <- Gen.integral (Range.constant 0 (n-lo))
return [(lo, len)])
- (\_ -> OR.slice)
+ (const OR.slice)
,testProperty "slice nD" $ prop_negate_with
(\k -> genRank (k (Const ())))
(\_ sh -> do let genPair n = do lo <- Gen.integral (Range.constant 0 (n-1))
@@ -148,6 +148,6 @@ tests = testGroup "C"
return (lo, len)
pairs <- mapM genPair (toList sh)
return pairs)
- (\_ -> OR.slice)
+ (const OR.slice)
]
]
diff --git a/test/Util.hs b/test/Util.hs
index 0273423..7c06b2f 100644
--- a/test/Util.hs
+++ b/test/Util.hs
@@ -1,7 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
generated by cgit v1.2.3-70-g09d2 (git 2.48.1) at 2025-05-14 08:06:59 +0200