aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Array')
-rw-r--r--src/Data/Array/Nested/Internal.hs7
1 files changed, 7 insertions, 0 deletions
diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs
index 41618c5..fb2ae48 100644
--- a/src/Data/Array/Nested/Internal.hs
+++ b/src/Data/Array/Nested/Internal.hs
@@ -10,6 +10,7 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
@@ -852,6 +853,7 @@ instance (KnownINat n, Storable a, Num a) => Num (Ranked n (Primitive a)) where
deriving via Ranked n (Primitive Int) instance KnownINat n => Num (Ranked n Int)
deriving via Ranked n (Primitive Double) instance KnownINat n => Num (Ranked n Double)
+type role ListR nominal representational
type ListR :: INat -> Type -> Type
data ListR n i where
ZR :: ListR Z i
@@ -871,6 +873,7 @@ listRToList ZR = []
listRToList (i ::: is) = i : listRToList is
-- | An index into a rank-typed array.
+type role IxR nominal representational
type IxR :: INat -> Type -> Type
newtype IxR n i = IxR (ListR n i)
deriving (Show, Eq, Ord)
@@ -901,6 +904,7 @@ unconsIxR (IxR sh) = case sh of
type IIxR n = IxR n Int
+type role StaticShapeR nominal representational
type StaticShapeR :: INat -> Type -> Type
newtype StaticShapeR n i = StaticShapeR (ListR n i)
deriving (Show, Eq, Ord)
@@ -1065,6 +1069,7 @@ instance (KnownShape sh, Storable a, Num a) => Num (Shaped sh (Primitive a)) whe
deriving via Shaped sh (Primitive Int) instance KnownShape sh => Num (Shaped sh Int)
deriving via Shaped sh (Primitive Double) instance KnownShape sh => Num (Shaped sh Double)
+type role ListS nominal representational
type ListS :: [Nat] -> Type -> Type
data ListS sh i where
ZS :: ListS '[] i
@@ -1089,6 +1094,7 @@ listSToList (i ::$ is) = i : listSToList is
-- (traditionally called \"@Fin@\"). Note that because the shape of a
-- shape-typed array is known statically, you can also retrieve the array shape
-- from a 'KnownShape' dictionary.
+type role IxS nominal representational
type IxS :: [Nat] -> Type -> Type
newtype IxS sh i = IxS (ListS sh i)
deriving (Show, Eq, Ord)
@@ -1119,6 +1125,7 @@ unconsIxS (IxS shl) = case shl of
type IIxS sh = IxS sh Int
+type role StaticShapeS nominal representational
type StaticShapeS :: [Nat] -> Type -> Type
newtype StaticShapeS sh i = StaticShapeS (ListS sh i)
deriving (Show, Eq, Ord)