diff options
| author | Mikolaj Konarski <mikolaj.konarski@funktory.com> | 2025-05-13 16:59:17 +0200 | 
|---|---|---|
| committer | Mikolaj Konarski <mikolaj.konarski@funktory.com> | 2025-05-13 16:59:17 +0200 | 
| commit | ca78d92aa55e9ba8ad179ef42515e4e7b2b8155a (patch) | |
| tree | 8311a404637693dbaec34e8ef13459e19cd20020 | |
| parent | 0b021e8630ab78ccad076cf8357e370f4a0fcab5 (diff) | |
Apply some suggestions from hlint
| -rw-r--r-- | bench/Main.hs | 18 | ||||
| -rw-r--r-- | ops/Data/Array/Strided/Arith/Internal.hs | 14 | ||||
| -rw-r--r-- | src/Data/Array/Mixed/Permutation.hs | 2 | ||||
| -rw-r--r-- | src/Data/Array/Mixed/Shape.hs | 2 | ||||
| -rw-r--r-- | src/Data/Array/Mixed/Types.hs | 2 | ||||
| -rw-r--r-- | src/Data/Array/Mixed/XArray.hs | 11 | ||||
| -rw-r--r-- | src/Data/Array/Nested/Internal/Mixed.hs | 4 | ||||
| -rw-r--r-- | src/Data/Array/Nested/Internal/Ranked.hs | 1 | ||||
| -rw-r--r-- | src/Data/Array/Nested/Internal/Shape.hs | 2 | ||||
| -rw-r--r-- | src/Data/Array/Nested/Internal/Shaped.hs | 3 | ||||
| -rw-r--r-- | test/Gen.hs | 3 | ||||
| -rw-r--r-- | test/Tests/C.hs | 14 | ||||
| -rw-r--r-- | test/Util.hs | 1 | 
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 #-}  | 
