aboutsummaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Array/Mixed.hs42
-rw-r--r--src/Data/Array/Nested/Internal.hs8
2 files changed, 42 insertions, 8 deletions
diff --git a/src/Data/Array/Mixed.hs b/src/Data/Array/Mixed.hs
index 03b411c..39d969c 100644
--- a/src/Data/Array/Mixed.hs
+++ b/src/Data/Array/Mixed.hs
@@ -34,6 +34,7 @@ import Data.Type.Bool
import Data.Type.Equality
import qualified Data.Vector.Storable as VS
import Foreign.Storable (Storable)
+import GHC.IsList
import GHC.TypeError
import GHC.TypeLits
import qualified GHC.TypeNats as TypeNats
@@ -223,6 +224,47 @@ instance Show (StaticShX sh) where
showsPrec _ (StaticShX l) = showListX (fromSMayNat shows (shows . fromSNat)) l
+-- | Evidence for the static part of a shape. This pops up only when you are
+-- polymorphic in the element type of an array.
+type KnownShX :: [Maybe Nat] -> Constraint
+class KnownShX sh where knownShX :: StaticShX sh
+instance KnownShX '[] where knownShX = ZKX
+instance (KnownNat n, KnownShX sh) => KnownShX (Just n : sh) where knownShX = SKnown natSing :!% knownShX
+instance KnownShX sh => KnownShX (Nothing : sh) where knownShX = SUnknown () :!% knownShX
+
+
+-- | Very untyped; length is checked at runtime.
+instance KnownShX sh => IsList (ListX sh (Const i)) where
+ type Item (ListX sh (Const i)) = i
+ fromList = go (knownShX @sh)
+ where
+ go :: StaticShX sh' -> [i] -> ListX sh' (Const i)
+ go ZKX [] = ZX
+ go (_ :!% sh) (i : is) = Const i ::% go sh is
+ go _ _ = error "IsList(ListX): Mismatched list length"
+ toList = go
+ where
+ go :: ListX sh' (Const i) -> [i]
+ go ZX = []
+ go (Const i ::% is) = i : go is
+
+-- | Very untyped; length is checked at runtime, and 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
+
+-- | Very untyped; length is checked at runtime, and known dimensions are *not checked*.
+-- instance KnownShX sh => IsList (ShX sh i) where
+-- type Item (ShX sh i) = i
+-- fromList = ShX . fmapListX (\(Const i) -> _) . fromList
+-- toList = go
+-- where
+-- go :: ShX sh' i -> [i]
+-- go ZSX = []
+-- go (Const i :$% is) = i : go is
+
+
type family Rank sh where
Rank '[] = 0
Rank (_ : sh) = 1 + Rank sh
diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs
index c66bd07..b9adde9 100644
--- a/src/Data/Array/Nested/Internal.hs
+++ b/src/Data/Array/Nested/Internal.hs
@@ -731,14 +731,6 @@ instance Elt a => Elt (Mixed sh' a) where
mvecsFreeze sh (MV_Nest sh' vecs) = M_Nest sh <$> mvecsFreeze (X.shAppend sh sh') vecs
--- | Evidence for the static part of a shape. This pops up only when you are
--- polymorphic in the element type of an array.
-type KnownShX :: [Maybe Nat] -> Constraint
-class KnownShX sh where knownShX :: StaticShX sh
-instance KnownShX '[] where knownShX = ZKX
-instance (KnownNat n, KnownShX sh) => KnownShX (Just n : sh) where knownShX = SKnown natSing :!% knownShX
-instance KnownShX sh => KnownShX (Nothing : sh) where knownShX = SUnknown () :!% knownShX
-
instance (KnownShX sh', KnownElt a) => KnownElt (Mixed sh' a) where
memptyArray sh = M_Nest sh (memptyArray (X.shAppend sh (X.completeShXzeros (knownShX @sh'))))