From ee319119b1f24db2b2e981e303db9935a1dca425 Mon Sep 17 00:00:00 2001 From: Mikolaj Konarski Date: Sat, 4 Apr 2026 16:26:06 +0200 Subject: Remove copies of length and toList operations that Foldable already provides in preparation for deriving Foldable for [] --- src/Data/Array/Nested/Mixed/Shape.hs | 20 +------------------- src/Data/Array/Nested/Ranked/Shape.hs | 17 ----------------- src/Data/Array/Nested/Shaped/Shape.hs | 21 ++------------------- 3 files changed, 3 insertions(+), 55 deletions(-) diff --git a/src/Data/Array/Nested/Mixed/Shape.hs b/src/Data/Array/Nested/Mixed/Shape.hs index 5887f4e..2dfcc8c 100644 --- a/src/Data/Array/Nested/Mixed/Shape.hs +++ b/src/Data/Array/Nested/Mixed/Shape.hs @@ -87,13 +87,9 @@ instance Foldable (ListX l) where {-# INLINE foldr #-} foldr _ z ZX = z foldr f z (x ::% xs) = f x (foldr f z xs) - toList = listxToList null ZX = False null _ = True -listxLength :: ListX sh i -> Int -listxLength = length - listxRank :: ListX sh i -> SNat (Rank sh) listxRank ZX = SNat listxRank (_ ::% l) | SNat <- listxRank l = SNat @@ -116,14 +112,6 @@ listxFromList topssh topl = go topssh topl ++ show (ssxLength topssh) ++ ", list has length " ++ show (length topl) ++ ")" -{-# INLINEABLE listxToList #-} -listxToList :: ListX sh i -> [i] -listxToList list = build (\(cons :: i -> is -> is) (nil :: is) -> - let go :: ListX sh i -> is - go ZX = nil - go (i ::% is) = i `cons` go is - in go list) - listxHead :: ListX (mn ': sh) i -> i listxHead (i ::% _) = i @@ -184,9 +172,6 @@ instance Show i => Show (IxX sh i) where showsPrec _ (IxX l) = listxShow shows l #endif -ixxLength :: IxX sh i -> Int -ixxLength (IxX l) = listxLength l - ixxRank :: IxX sh i -> SNat (Rank sh) ixxRank (IxX l) = listxRank l @@ -202,9 +187,6 @@ ixxZero' (_ :$% sh) = 0 :.% ixxZero' sh ixxFromList :: forall sh i. StaticShX sh -> [i] -> IxX sh i ixxFromList = coerce (listxFromList @_ @i) -ixxToList :: IxX sh i -> [i] -ixxToList = Foldable.toList - ixxHead :: IxX (n : sh) i -> i ixxHead (IxX list) = listxHead list @@ -794,7 +776,7 @@ shxFlatten = go (SNat @1) instance KnownShX sh => IsList (ListX sh i) where type Item (ListX sh i) = i fromList = listxFromList (knownShX @sh) - toList = listxToList + toList = Foldable.toList -- | Very untyped: only length is checked (at runtime), index bounds are __not checked__. instance KnownShX sh => IsList (IxX sh i) where diff --git a/src/Data/Array/Nested/Ranked/Shape.hs b/src/Data/Array/Nested/Ranked/Shape.hs index 6d94c8d..2166123 100644 --- a/src/Data/Array/Nested/Ranked/Shape.hs +++ b/src/Data/Array/Nested/Ranked/Shape.hs @@ -113,9 +113,6 @@ listrShow f l = showString "[" . go "" l . showString "]" go _ ZR = id go prefix (x ::: xs) = showString prefix . f x . go "," xs -listrLength :: ListR n i -> Int -listrLength = length - listrRank :: ListR n i -> SNat n listrRank ZR = SNat listrRank (_ ::: sh) = snatSucc (listrRank sh) @@ -134,14 +131,6 @@ listrFromList topsn topl = go topsn topl ++ show (fromSNat topsn) ++ ", list has length " ++ show (length topl) ++ ")" -{-# INLINEABLE listrToList #-} -listrToList :: ListR n i -> [i] -listrToList list = build (\(cons :: i -> is -> is) (nil :: is) -> - let go :: ListR n i -> is - go ZR = nil - go (i ::: is) = i `cons` go is - in go list) - listrHead :: ListR (n + 1) i -> i listrHead (i ::: _) = i @@ -237,9 +226,6 @@ instance Show i => Show (IxR n i) where showsPrec _ (IxR l) = listrShow shows l #endif -ixrLength :: IxR sh i -> Int -ixrLength (IxR l) = listrLength l - ixrRank :: IxR n i -> SNat n ixrRank (IxR sh) = listrRank sh @@ -251,9 +237,6 @@ ixrZero (SS n) = 0 :.: ixrZero n ixrFromList :: forall n i. SNat n -> [i] -> IxR n i ixrFromList = coerce (listrFromList @_ @i) -ixrToList :: IxR n i -> [i] -ixrToList = Foldable.toList - ixrHead :: IxR (n + 1) i -> i ixrHead (IxR list) = listrHead list diff --git a/src/Data/Array/Nested/Shaped/Shape.hs b/src/Data/Array/Nested/Shaped/Shape.hs index c39d482..274f954 100644 --- a/src/Data/Array/Nested/Shaped/Shape.hs +++ b/src/Data/Array/Nested/Shaped/Shape.hs @@ -89,9 +89,6 @@ listsShow f l = showString "[" . go "" l . showString "]" go _ ZS = id go prefix (x ::$ xs) = showString prefix . f x . go "," xs -listsLength :: ListS sh i -> Int -listsLength = length - listsRank :: ListS sh i -> SNat (Rank sh) listsRank ZS = SNat listsRank (_ ::$ sh) = snatSucc (listsRank sh) @@ -114,17 +111,9 @@ listsFromListS topl0 topl = go topl0 topl go ZS [] = ZS go (_ ::$ l0) (i : is) = i ::$ go l0 is go _ _ = error $ "listsFromListS: Mismatched list length (the model says " - ++ show (listsLength topl0) ++ ", list has length " + ++ show (length topl0) ++ ", list has length " ++ show (length topl) ++ ")" -{-# INLINEABLE listsToList #-} -listsToList :: ListS sh i -> [i] -listsToList list = build (\(cons :: i -> is -> is) (nil :: is) -> - let go :: ListS sh i -> is - go ZS = nil - go (i ::$ is) = i `cons` go is - in go list) - listsHead :: ListS (n : sh) i -> i listsHead (i ::$ _) = i @@ -208,9 +197,6 @@ instance Show i => Show (IxS sh i) where showsPrec _ (IxS l) = listsShow (\i -> shows i) l #endif -ixsLength :: IxS sh i -> Int -ixsLength (IxS l) = listsLength l - ixsRank :: IxS sh i -> SNat (Rank sh) ixsRank (IxS l) = listsRank l @@ -221,9 +207,6 @@ ixsFromList = coerce (listsFromList @_ @i) ixsFromIxS :: forall sh i0 i. IxS sh i0 -> [i] -> IxS sh i ixsFromIxS = coerce (listsFromListS @_ @i0 @i) -ixsToList :: IxS sh i -> [i] -ixsToList = Foldable.toList - ixsZero :: ShS sh -> IIxS sh ixsZero ZSS = ZIS ixsZero (_ :$$ sh) = 0 :.$ ixsZero sh @@ -481,7 +464,7 @@ shsOrthotopeShape (SNat :$$ sh) | Dict <- shsOrthotopeShape sh = Dict instance KnownShS sh => IsList (ListS sh i) where type Item (ListS sh i) = i fromList = listsFromList (knownShS @sh) - toList = listsToList + toList = Foldable.toList -- | Very untyped: only length is checked (at runtime), index bounds are __not checked__. instance KnownShS sh => IsList (IxS sh i) where -- cgit v1.3