aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Array')
-rw-r--r--src/Data/Array/Mixed/Permutation.hs5
-rw-r--r--src/Data/Array/Mixed/XArray.hs (renamed from src/Data/Array/Mixed.hs)6
-rw-r--r--src/Data/Array/Nested.hs13
-rw-r--r--src/Data/Array/Nested/Internal/Convert.hs (renamed from src/Data/Array/Nested/Convert.hs)12
-rw-r--r--src/Data/Array/Nested/Internal/Lemmas.hs (renamed from src/Data/Array/Nested/Lemmas.hs)4
-rw-r--r--src/Data/Array/Nested/Internal/Mixed.hs (renamed from src/Data/Array/Nested/Mixed.hs)6
-rw-r--r--src/Data/Array/Nested/Internal/Ranked.hs (renamed from src/Data/Array/Nested/Ranked.hs)10
-rw-r--r--src/Data/Array/Nested/Internal/Shape.hs (renamed from src/Data/Array/Nested/Shape.hs)2
-rw-r--r--src/Data/Array/Nested/Internal/Shaped.hs (renamed from src/Data/Array/Nested/Shaped.hs)12
9 files changed, 35 insertions, 35 deletions
diff --git a/src/Data/Array/Mixed/Permutation.hs b/src/Data/Array/Mixed/Permutation.hs
index 83a5ee4..6ff3bdc 100644
--- a/src/Data/Array/Mixed/Permutation.hs
+++ b/src/Data/Array/Mixed/Permutation.hs
@@ -61,6 +61,11 @@ permToList (x `PCons` l) = TN.fromSNat x : permToList l
permToList' :: Perm list -> [Int]
permToList' = map fromIntegral . permToList
+-- | Utility class for generating permutations from type class information.
+class KnownPerm l where makePerm :: Perm l
+instance KnownPerm '[] where makePerm = PNil
+instance (KnownNat n, KnownPerm l) => KnownPerm (n : l) where makePerm = natSing `PCons` makePerm
+
-- ** Applying permutations
diff --git a/src/Data/Array/Mixed.hs b/src/Data/Array/Mixed/XArray.hs
index 4a338a2..cc0a6a5 100644
--- a/src/Data/Array/Mixed.hs
+++ b/src/Data/Array/Mixed/XArray.hs
@@ -12,7 +12,7 @@
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
-module Data.Array.Mixed where
+module Data.Array.Mixed.XArray where
import Control.DeepSeq (NFData(..))
import Data.Array.Ranked qualified as ORB
@@ -191,10 +191,6 @@ rerank2 ssh ssh1 ssh2 f xarr1@(XArray arr1) (XArray arr2)
(\a b -> let XArray r = f (XArray a) (XArray b) in r)
arr1 arr2)
-class KnownNatList l where makeNatList :: Perm l
-instance KnownNatList '[] where makeNatList = PNil
-instance (KnownNat n, KnownNatList l) => KnownNatList (n : l) where makeNatList = natSing `PCons` makeNatList
-
-- | The list argument gives indices into the original dimension list.
transpose :: forall is sh a. (IsPermutation is, Rank is <= Rank sh)
=> StaticShX sh
diff --git a/src/Data/Array/Nested.hs b/src/Data/Array/Nested.hs
index c982b4d..4d2d616 100644
--- a/src/Data/Array/Nested.hs
+++ b/src/Data/Array/Nested.hs
@@ -61,21 +61,20 @@ module Data.Array.Nested (
pattern SZ, pattern SS,
Perm(..),
IsPermutation,
- KnownNatList(..),
+ KnownPerm(..),
NumElt, FloatElt,
) where
import Prelude hiding (mappend)
-import Data.Array.Mixed
import Data.Array.Mixed.Internal.Arith
import Data.Array.Mixed.Permutation
import Data.Array.Mixed.Shape
import Data.Array.Mixed.Types
-import Data.Array.Nested.Convert
-import Data.Array.Nested.Mixed
-import Data.Array.Nested.Ranked
-import Data.Array.Nested.Shape
-import Data.Array.Nested.Shaped
+import Data.Array.Nested.Internal.Convert
+import Data.Array.Nested.Internal.Mixed
+import Data.Array.Nested.Internal.Ranked
+import Data.Array.Nested.Internal.Shape
+import Data.Array.Nested.Internal.Shaped
import Foreign.Storable
import GHC.TypeLits
diff --git a/src/Data/Array/Nested/Convert.hs b/src/Data/Array/Nested/Internal/Convert.hs
index cb22c32..e101981 100644
--- a/src/Data/Array/Nested/Convert.hs
+++ b/src/Data/Array/Nested/Internal/Convert.hs
@@ -3,17 +3,17 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
-module Data.Array.Nested.Convert where
+module Data.Array.Nested.Internal.Convert where
import Data.Type.Equality
import Data.Array.Mixed.Lemmas
import Data.Array.Mixed.Shape
-import Data.Array.Nested.Lemmas
-import Data.Array.Nested.Mixed
-import Data.Array.Nested.Ranked
-import Data.Array.Nested.Shape
-import Data.Array.Nested.Shaped
+import Data.Array.Nested.Internal.Lemmas
+import Data.Array.Nested.Internal.Mixed
+import Data.Array.Nested.Internal.Ranked
+import Data.Array.Nested.Internal.Shape
+import Data.Array.Nested.Internal.Shaped
stoRanked :: Elt a => Shaped sh a -> Ranked (Rank sh) a
diff --git a/src/Data/Array/Nested/Lemmas.hs b/src/Data/Array/Nested/Internal/Lemmas.hs
index c4fe066..5ce5373 100644
--- a/src/Data/Array/Nested/Lemmas.hs
+++ b/src/Data/Array/Nested/Internal/Lemmas.hs
@@ -3,7 +3,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
-module Data.Array.Nested.Lemmas where
+module Data.Array.Nested.Internal.Lemmas where
import Data.Proxy
import Data.Type.Equality
@@ -13,7 +13,7 @@ import Data.Array.Mixed.Lemmas
import Data.Array.Mixed.Permutation
import Data.Array.Mixed.Shape
import Data.Array.Mixed.Types
-import Data.Array.Nested.Shape
+import Data.Array.Nested.Internal.Shape
lemRankMapJust :: ShS sh -> Rank (MapJust sh) :~: Rank sh
diff --git a/src/Data/Array/Nested/Mixed.hs b/src/Data/Array/Nested/Internal/Mixed.hs
index 84e16b3..98871d5 100644
--- a/src/Data/Array/Nested/Mixed.hs
+++ b/src/Data/Array/Nested/Internal/Mixed.hs
@@ -15,7 +15,7 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
-module Data.Array.Nested.Mixed where
+module Data.Array.Nested.Internal.Mixed where
import Control.DeepSeq (NFData)
import Control.Monad (forM_, when)
@@ -36,8 +36,8 @@ import GHC.Float qualified (log1p, expm1, log1pexp, log1mexp)
import GHC.Generics (Generic)
import GHC.TypeLits
-import Data.Array.Mixed (XArray(..))
-import Data.Array.Mixed qualified as X
+import Data.Array.Mixed.XArray (XArray(..))
+import Data.Array.Mixed.XArray qualified as X
import Data.Array.Mixed.Internal.Arith
import Data.Array.Mixed.Shape
import Data.Array.Mixed.Types
diff --git a/src/Data/Array/Nested/Ranked.hs b/src/Data/Array/Nested/Internal/Ranked.hs
index c2f9405..d5bd70f 100644
--- a/src/Data/Array/Nested/Ranked.hs
+++ b/src/Data/Array/Nested/Internal/Ranked.hs
@@ -16,7 +16,7 @@
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
-module Data.Array.Nested.Ranked where
+module Data.Array.Nested.Internal.Ranked where
import Prelude hiding (mappend)
@@ -35,14 +35,14 @@ import GHC.Float qualified (log1p, expm1, log1pexp, log1mexp)
import GHC.TypeLits
import GHC.TypeNats qualified as TN
-import Data.Array.Mixed (XArray(..))
-import Data.Array.Mixed qualified as X
+import Data.Array.Mixed.XArray (XArray(..))
+import Data.Array.Mixed.XArray qualified as X
import Data.Array.Mixed.Internal.Arith
import Data.Array.Mixed.Lemmas
import Data.Array.Mixed.Shape
import Data.Array.Mixed.Types
-import Data.Array.Nested.Mixed
-import Data.Array.Nested.Shape
+import Data.Array.Nested.Internal.Mixed
+import Data.Array.Nested.Internal.Shape
-- | A rank-typed array: the number of dimensions of the array (its /rank/) is
diff --git a/src/Data/Array/Nested/Shape.hs b/src/Data/Array/Nested/Internal/Shape.hs
index 774b4bd..319f171 100644
--- a/src/Data/Array/Nested/Shape.hs
+++ b/src/Data/Array/Nested/Internal/Shape.hs
@@ -20,7 +20,7 @@
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
-module Data.Array.Nested.Shape where
+module Data.Array.Nested.Internal.Shape where
import Data.Array.Mixed.Types
import Data.Coerce (coerce)
diff --git a/src/Data/Array/Nested/Shaped.hs b/src/Data/Array/Nested/Internal/Shaped.hs
index 934433e..afa91eb 100644
--- a/src/Data/Array/Nested/Shaped.hs
+++ b/src/Data/Array/Nested/Internal/Shaped.hs
@@ -15,7 +15,7 @@
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
-module Data.Array.Nested.Shaped where
+module Data.Array.Nested.Internal.Shaped where
import Prelude hiding (mappend)
@@ -32,16 +32,16 @@ import Foreign.Storable (Storable)
import GHC.Float qualified (log1p, expm1, log1pexp, log1mexp)
import GHC.TypeLits
-import Data.Array.Mixed (XArray)
-import Data.Array.Mixed qualified as X
+import Data.Array.Mixed.XArray (XArray)
+import Data.Array.Mixed.XArray qualified as X
import Data.Array.Mixed.Internal.Arith
import Data.Array.Mixed.Lemmas
import Data.Array.Mixed.Permutation
import Data.Array.Mixed.Shape
import Data.Array.Mixed.Types
-import Data.Array.Nested.Lemmas
-import Data.Array.Nested.Mixed
-import Data.Array.Nested.Shape
+import Data.Array.Nested.Internal.Lemmas
+import Data.Array.Nested.Internal.Mixed
+import Data.Array.Nested.Internal.Shape
-- | A shape-typed array: the full shape of the array (the sizes of its