aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array/Mixed.hs
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2024-05-19 16:59:46 +0200
committerTom Smeding <tom@tomsmeding.com>2024-05-19 16:59:46 +0200
commit89f14f77489d1be05aa71991382b01fae6d29a1e (patch)
tree09b5e8179edc61e7b27bd7bf72c5c5e1e497e357 /src/Data/Array/Mixed.hs
parent2bfd35243211d2acbc35629d448d27a51a9112bc (diff)
Expose all IsList(toList) functions without constraints
Some are Foldable.toList, some are a separate top-level function
Diffstat (limited to 'src/Data/Array/Mixed.hs')
-rw-r--r--src/Data/Array/Mixed.hs28
1 files changed, 15 insertions, 13 deletions
diff --git a/src/Data/Array/Mixed.hs b/src/Data/Array/Mixed.hs
index fa61b01..6ac3ab3 100644
--- a/src/Data/Array/Mixed.hs
+++ b/src/Data/Array/Mixed.hs
@@ -28,6 +28,7 @@ import qualified Data.Array.RankedS as S
import qualified Data.Array.Ranked as ORB
import Data.Bifunctor (first)
import Data.Coerce
+import qualified Data.Foldable as Foldable
import Data.Functor.Const
import Data.Kind
import Data.Monoid (Sum(..))
@@ -36,7 +37,8 @@ import Data.Type.Bool
import Data.Type.Equality
import qualified Data.Vector.Storable as VS
import Foreign.Storable (Storable)
-import GHC.IsList
+import GHC.IsList (IsList)
+import qualified GHC.IsList as IsList
import GHC.TypeError
import GHC.TypeLits
import qualified GHC.TypeNats as TypeNats
@@ -125,6 +127,10 @@ showListX f l = showString "[" . go "" l . showString "]"
go _ ZX = id
go prefix (x ::% xs) = showString prefix . f x . go "," xs
+listXToList :: ListX sh' (Const i) -> [i]
+listXToList ZX = []
+listXToList (Const i ::% is) = i : listXToList is
+
type role IxX nominal representational
type IxX :: [Maybe Nat] -> Type -> Type
@@ -199,6 +205,10 @@ instance Functor (ShX sh) where
lengthShX :: ShX sh i -> Int
lengthShX (ShX l) = lengthListX l
+shXToList :: IShX sh -> [Int]
+shXToList ZSX = []
+shXToList (smn :$% sh) = fromSMayNat' smn : shXToList sh
+
-- | The part of a shape that is statically known.
type StaticShX :: [Maybe Nat] -> Type
@@ -245,17 +255,13 @@ instance KnownShX sh => IsList (ListX sh (Const i)) where
go _ _ = error $ "IsList(ListX): Mismatched list length (type says "
++ show (lengthStaticShX (knownShX @sh)) ++ ", list has length "
++ show (length topl) ++ ")"
- toList = go
- where
- go :: ListX sh' (Const i) -> [i]
- go ZX = []
- go (Const i ::% is) = i : go is
+ toList = listXToList
-- | Very untyped: only length is checked (at runtime), index bounds are __not checked__.
instance KnownShX sh => IsList (IxX sh i) where
type Item (IxX sh i) = i
- fromList = IxX . fromList
- toList (IxX l) = toList l
+ fromList = IxX . IsList.fromList
+ toList = Foldable.toList
-- | Untyped: length and known dimensions are checked (at runtime).
instance KnownShX sh => IsList (ShX sh Int) where
@@ -272,11 +278,7 @@ instance KnownShX sh => IsList (ShX sh Int) where
go _ _ = error $ "IsList(ShX): Mismatched list length (type says "
++ show (lengthStaticShX (knownShX @sh)) ++ ", list has length "
++ show (length topl) ++ ")"
- toList = go
- where
- go :: ShX sh' Int -> [Int]
- go ZSX = []
- go (smn :$% sh) = fromSMayNat' smn : go sh
+ toList = shXToList
type family Rank sh where