summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcchalmers <>2020-11-20 22:16:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-11-20 22:16:00 (GMT)
commit3c5ad5806ae0420efecfa09cb4302affb4d1ca66 (patch)
treef41bfad657f802374e70bc7e8395f6463fce7c34
parente1b9a1d2ce9c669db596b7735fd40640666afcfe (diff)
version 0.1.0.1HEAD0.1.0.1master
-rwxr-xr-x[-rw-r--r--]README.md2
-rw-r--r--dense.cabal8
-rw-r--r--src/Data/Dense/Base.hs1
-rw-r--r--src/Data/Dense/Generic.hs12
-rw-r--r--src/Data/Dense/Index.hs61
-rw-r--r--src/Data/Dense/Mutable.hs60
-rw-r--r--src/Data/Dense/TH.hs14
7 files changed, 90 insertions, 68 deletions
diff --git a/README.md b/README.md
index 2cfd3b4..ba42f13 100644..100755
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
## dense
-[![Build Status](https://travis-ci.org/cchalmers/dense.svg)](https://travis-ci.org/cchalmers/dense)
+[![Build Status](https://travis-ci.org/cchalmers/dense.svg?branch=master)](https://travis-ci.org/cchalmers/dense)
[![Haddock](https://rawgit.com/cchalmers/dense/gh-pages/haddock.svg)](https://cchalmers.github.io/dense/)
[![Hackage](https://img.shields.io/hackage/v/dense.svg?style=flat)](https://hackage.haskell.org/package/dense)
diff --git a/dense.cabal b/dense.cabal
index bee3ea5..703ed6f 100644
--- a/dense.cabal
+++ b/dense.cabal
@@ -1,5 +1,5 @@
name: dense
-version: 0.1.0.0
+version: 0.1.0.1
synopsis: Mutable and immutable dense multidimensional arrays
description:
Multidimentional array library build on top of the vector package,
@@ -46,13 +46,13 @@ library
ghc-prim,
hashable,
lens,
- linear >= 1.20 && <1.21,
+ linear >= 1.20 && <1.22,
primitive,
semigroupoids,
template-haskell,
transformers,
transformers-compat,
- vector
+ vector >= 0.12 && < 0.13
hs-source-dirs: src
ghc-options: -Wall
default-language: Haskell2010
@@ -72,7 +72,7 @@ test-suite doctests
ghc-prim,
hashable,
lens,
- linear >= 1.20 && <1.21,
+ linear >= 1.20 && <1.22,
primitive,
semigroupoids,
template-haskell,
diff --git a/src/Data/Dense/Base.hs b/src/Data/Dense/Base.hs
index 013629b..9774494 100644
--- a/src/Data/Dense/Base.hs
+++ b/src/Data/Dense/Base.hs
@@ -11,6 +11,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Dense.Base
diff --git a/src/Data/Dense/Generic.hs b/src/Data/Dense/Generic.hs
index 487d284..cb19cf3 100644
--- a/src/Data/Dense/Generic.hs
+++ b/src/Data/Dense/Generic.hs
@@ -72,6 +72,7 @@ module Data.Dense.Generic
-- ** Monadic initialisation
, create
+ , createT
, replicateM
, generateM
, linearGenerateM
@@ -213,6 +214,7 @@ import qualified Data.Foldable as F
import Data.Functor.Classes
import qualified Data.List as L
import Data.Maybe (fromMaybe)
+import qualified Data.Traversable as T
import Data.Typeable
import qualified Data.Vector as B
import Data.Vector.Fusion.Bundle (MBundle)
@@ -410,6 +412,14 @@ create :: Vector v a => (forall s. ST s (MArray (G.Mutable v) f s a)) -> Array v
create m = m `seq` runST (m >>= unsafeFreeze)
{-# INLINE create #-}
+-- | Execute the monadic action and freeze the resulting array.
+createT
+ :: (Vector v a, Traversable t)
+ => (forall s . ST s (t (MArray (G.Mutable v) f s a)))
+ -> t (Array v f a)
+createT m = m `seq` runST (m >>= T.mapM unsafeFreeze)
+{-# INLINE createT #-}
+
-- | O(n) Array of the given shape with the same value in each position.
replicate :: (Shape f, Vector v a) => f Int -> a -> Array v f a
replicate l a
@@ -611,7 +621,7 @@ zipWith :: (Shape f, Vector v a, Vector v b, Vector v c)
-> Array v f b
-> Array v f c
zipWith f a1@(Array l1 v1) a2@(Array l2 v2)
- | eq1 l1 l1 = Array l1 $ G.zipWith f v1 v2
+ | eq1 l1 l2 = Array l1 $ G.zipWith f v1 v2
| otherwise = Array l' $ G.unstream $
MBundle.fromStream (Stream.zipWith f (streamSub l' a1) (streamSub l' a2)) (Exact (shapeSize l'))
where l' = shapeIntersect l1 l2
diff --git a/src/Data/Dense/Index.hs b/src/Data/Dense/Index.hs
index 4ccb474..31d4231 100644
--- a/src/Data/Dense/Index.hs
+++ b/src/Data/Dense/Index.hs
@@ -81,12 +81,12 @@ type Layout f = f Int
class (Eq1 f, Additive f, Traversable f) => Shape f where
-- | Convert a shape to its linear index using the 'Layout'.
shapeToIndex :: Layout f -> f Int -> Int
- shapeToIndex l x = F.foldl (\k (e, a) -> k * e + a) 0 (liftI2 (,) l x)
+ shapeToIndex l x = F.foldr (\(e, a) k -> a + e*k) 0 (liftI2 (,) l x)
{-# INLINE shapeToIndex #-}
-- | Convert a linear index to a shape the 'Layout'.
shapeFromIndex :: Layout f -> Int -> f Int
- shapeFromIndex l i = snd $ mapAccumR quotRem i l
+ shapeFromIndex l i = snd $ mapAccumL quotRem i l
{-# INLINE shapeFromIndex #-}
-- | Calculate the intersection of two shapes.
@@ -148,59 +148,62 @@ instance Shape V1 where
shapeInRange m i = i >= 0 && i < m
instance Shape V2 where
- shapeToIndex (V2 _x y) (V2 i j) = y*i + j
+ shapeToIndex (V2 x _y) (V2 i j) = i + x*j
{-# INLINE shapeToIndex #-}
- shapeFromIndex (V2 _x y) n = V2 i j
- where (i, j) = n `quotRem` y
+ shapeFromIndex (V2 x _y) n = V2 i j
+ where (j, i) = n `quotRem` x
{-# INLINE shapeFromIndex #-}
shapeStep (V2 x y) (V2 i j)
- | j + 1 < y = Just (V2 i (j + 1))
- | i + 1 < x = Just (V2 (i + 1) 0 )
+ | i + 1 < x = Just (V2 (i + 1) j )
+ | j + 1 < y = Just (V2 0 (j + 1))
| otherwise = Nothing
{-# INLINE shapeStep #-}
- unsafeShapeStep (V2 _ y) (V2 i j)
- | j + 1 < y = V2 i (j + 1)
- | otherwise = V2 (i + 1) 0
+ unsafeShapeStep (V2 x _y) (V2 i j)
+ | i + 1 < x = V2 (i + 1) j
+ | otherwise = V2 0 (j + 1)
{-# INLINE unsafeShapeStep #-}
- shapeStepBetween (V2 _ia ja) (V2 ib jb) (V2 i j)
- | j + 1 < jb = Just (V2 i (j + 1))
- | i + 1 < ib = Just (V2 (i + 1) ja )
+ shapeStepBetween (V2 ia _ja) (V2 ib jb) (V2 i j)
+ | i + 1 < ib = Just (V2 (i + 1) j )
+ | j + 1 < jb = Just (V2 ia (j + 1))
| otherwise = Nothing
{-# INLINE shapeStepBetween #-}
instance Shape V3 where
+ shapeToIndex (V3 x y _z) (V3 i j k) = i + x*(j + y*k)
+ {-# INLINE shapeToIndex #-}
+
shapeStep (V3 x y z) (V3 i j k)
- | k + 1 < z = Just (V3 i j (k + 1))
- | j + 1 < y = Just (V3 i (j + 1) 0 )
- | i + 1 < x = Just (V3 (i + 1) 0 0 )
+ | k + 1 < z = Just (V3 (i + 1) j k )
+ | j + 1 < y = Just (V3 0 (j + 1) k )
+ | i + 1 < x = Just (V3 0 0 (k + 1))
| otherwise = Nothing
{-# INLINE shapeStep #-}
- shapeStepBetween (V3 _ia ja ka) (V3 ib jb kb) (V3 i j k)
- | k < kb = Just (V3 i j (k + 1))
- | j < jb = Just (V3 i (j + 1) ka )
- | i < ib = Just (V3 (i + 1) ja ka )
+ shapeStepBetween (V3 ia ja _ka) (V3 ib jb kb) (V3 i j k)
+ | k < kb = Just (V3 (i + 1) j k )
+ | j < jb = Just (V3 ia (j + 1) k )
+ | i < ib = Just (V3 ia ja (k + 1))
| otherwise = Nothing
{-# INLINE shapeStepBetween #-}
instance Shape V4 where
shapeStep (V4 x y z w) (V4 i j k l)
- | l + 1 < w = Just (V4 i j k (l + 1))
- | k + 1 < z = Just (V4 i j (k + 1) 0 )
- | j + 1 < y = Just (V4 i (j + 1) 0 0 )
- | i + 1 < x = Just (V4 (i + 1) 0 0 0 )
+ | l + 1 < w = Just (V4 (i + 1) j k l )
+ | k + 1 < z = Just (V4 0 (j + 1) k l )
+ | j + 1 < y = Just (V4 0 0 (k + 1) l )
+ | i + 1 < x = Just (V4 0 0 0 (l + 1))
| otherwise = Nothing
{-# INLINE shapeStep #-}
- shapeStepBetween (V4 _ia ja ka la) (V4 ib jb kb lb) (V4 i j k l)
- | l < lb = Just (V4 i j k (l + 1))
- | k < kb = Just (V4 i j (k + 1) la )
- | j < jb = Just (V4 i (j + 1) ka la )
- | i < ib = Just (V4 (i + 1) ja ka la )
+ shapeStepBetween (V4 ia ja ka _la) (V4 ib jb kb lb) (V4 i j k l)
+ | l < lb = Just (V4 (i + 1) j k l )
+ | k < kb = Just (V4 ia (j + 1) k l )
+ | j < jb = Just (V4 ia ja (k + 1) l )
+ | i < ib = Just (V4 ia ia ka (l + 1))
| otherwise = Nothing
{-# INLINE shapeStepBetween #-}
diff --git a/src/Data/Dense/Mutable.hs b/src/Data/Dense/Mutable.hs
index a7e3de9..d0e79b1 100644
--- a/src/Data/Dense/Mutable.hs
+++ b/src/Data/Dense/Mutable.hs
@@ -107,7 +107,7 @@ type PMArray = MArray P.MVector
-- | Lens onto the shape of the vector. The total size of the layout
-- _must_ remain the same or an error is thrown.
-mlayout :: (Shape l, Shape l') => Lens (MArray v l s a) (MArray v l' s a) (Layout l) (Layout l')
+mlayout :: (Shape f, Shape f') => Lens (MArray v f s a) (MArray v f' s a) (Layout f) (Layout f')
mlayout f (MArray l v) = f l <&> \l' ->
sizeMissmatch (F.product l) (F.product l')
("mlayout: trying to replace shape " ++ showShape l ++ ", with " ++ showShape l')
@@ -121,7 +121,7 @@ instance Shape f => HasLayout f (MArray v f s a) where
-- | Indexed lens over the underlying vector of an array. The index is
-- the 'extent' of the array. You must __not__ change the length of
-- the vector, otherwise an error will be thrown.
-mvector :: (MVector v a, MVector w b) => IndexedLens (Layout l) (MArray v l s a) (MArray w l t b) (v s a) (w t b)
+mvector :: (MVector v a, MVector w b) => IndexedLens (Layout f) (MArray v f s a) (MArray w f t b) (v s a) (w t b)
mvector f (MArray l v) =
indexed f l v <&> \w ->
sizeMissmatch (GM.length v) (GM.length w)
@@ -130,23 +130,23 @@ mvector f (MArray l v) =
{-# INLINE mvector #-}
-- | New mutable array with shape @l@.
-new :: (PrimMonad m, Shape l, MVector v a) => Layout l -> m (MArray v l (PrimState m) a)
+new :: (PrimMonad m, Shape f, MVector v a) => Layout f -> m (MArray v f (PrimState m) a)
new l = MArray l `liftM` GM.new (F.product l)
{-# INLINE new #-}
-- | New mutable array with shape @l@ filled with element @a@.
-replicate :: (PrimMonad m, Shape l, MVector v a) => Layout l -> a -> m (MArray v l (PrimState m) a)
+replicate :: (PrimMonad m, Shape f, MVector v a) => Layout f -> a -> m (MArray v f (PrimState m) a)
replicate l a = MArray l `liftM` GM.replicate (F.product l) a
{-# INLINE replicate #-}
-- | New mutable array with shape @l@ filled with result of monadic
-- action @a@.
-replicateM :: (PrimMonad m, Shape l, MVector v a) => Layout l -> m a -> m (MArray v l (PrimState m) a)
+replicateM :: (PrimMonad m, Shape f, MVector v a) => Layout f -> m a -> m (MArray v f (PrimState m) a)
replicateM l a = MArray l `liftM` GM.replicateM (F.product l) a
{-# INLINE replicateM #-}
-- | Clone a mutable array, making a new, separate mutable array.
-clone :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> m (MArray v l (PrimState m) a)
+clone :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> m (MArray v f (PrimState m) a)
clone (MArray l v) = MArray l `liftM` GM.clone v
{-# INLINE clone #-}
@@ -154,130 +154,130 @@ clone (MArray l v) = MArray l `liftM` GM.clone v
-- | Clear the elements of a mutable array. This is usually a no-op for
-- unboxed arrays.
-clear :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> m ()
+clear :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> m ()
clear (MArray _ v) = GM.clear v
{-# INLINE clear #-}
-- | Read a mutable array at element @l@.
-read :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> m a
+read :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> m a
read (MArray l v) s = boundsCheck l s $ GM.unsafeRead v (shapeToIndex l s)
{-# INLINE read #-}
-- | Write a mutable array at element @l@.
-write :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m ()
+write :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m ()
write (MArray l v) s a = boundsCheck l s $ GM.unsafeWrite v (shapeToIndex l s) a
{-# INLINE write #-}
-- | Modify a mutable array at element @l@ by applying a function.
-modify :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> (a -> a) -> m ()
+modify :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> (a -> a) -> m ()
modify (MArray l v) s f = boundsCheck l s $ GM.unsafeRead v i >>= GM.unsafeWrite v i . f
where i = shapeToIndex l s
{-# INLINE modify #-}
-- | Swap two elements in a mutable array.
-swap :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> l Int -> m ()
+swap :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> f Int -> m ()
swap (MArray l v) i j = boundsCheck l i boundsCheck l j $ GM.unsafeSwap v (shapeToIndex l i) (shapeToIndex l j)
{-# INLINE swap #-}
-- | Replace the element at the give position and return the old
-- element.
-exchange :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m a
+exchange :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m a
exchange (MArray l v) i a = boundsCheck l i $ GM.unsafeExchange v (shapeToIndex l i) a
{-# INLINE exchange #-}
-- | Read a mutable array at element @i@ by indexing the internal
-- vector.
-linearRead :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> m a
+linearRead :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> m a
linearRead (MArray _ v) = GM.read v
{-# INLINE linearRead #-}
-- | Write a mutable array at element @i@ by indexing the internal
-- vector.
-linearWrite :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m ()
+linearWrite :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m ()
linearWrite (MArray _ v) = GM.write v
{-# INLINE linearWrite #-}
-- | Swap two elements in a mutable array by indexing the internal
-- vector.
-linearSwap :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> Int -> m ()
+linearSwap :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> Int -> m ()
linearSwap (MArray _ v) = GM.swap v
{-# INLINE linearSwap #-}
-- | Modify a mutable array at element @i@ by applying a function.
-linearModify :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> (a -> a) -> m ()
+linearModify :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> (a -> a) -> m ()
linearModify (MArray _ v) i f = GM.read v i >>= GM.unsafeWrite v i . f
{-# INLINE linearModify #-}
-- | Replace the element at the give position and return the old
-- element.
-linearExchange :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m a
+linearExchange :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m a
linearExchange (MArray _ v) i a = GM.exchange v i a
{-# INLINE linearExchange #-}
-- Unsafe varients
-- | 'read' without bounds checking.
-unsafeRead :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> m a
+unsafeRead :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> m a
unsafeRead (MArray l v) s = GM.unsafeRead v (shapeToIndex l s)
{-# INLINE unsafeRead #-}
-- | 'write' without bounds checking.
-unsafeWrite :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m ()
+unsafeWrite :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m ()
unsafeWrite (MArray l v) s = GM.unsafeWrite v (shapeToIndex l s)
{-# INLINE unsafeWrite #-}
-- | 'swap' without bounds checking.
-unsafeSwap :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> l Int -> m ()
+unsafeSwap :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> f Int -> m ()
unsafeSwap (MArray l v) s j = GM.unsafeSwap v (shapeToIndex l s) (shapeToIndex j s)
{-# INLINE unsafeSwap #-}
-- | 'modify' without bounds checking.
-unsafeModify :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> (a -> a) -> m ()
+unsafeModify :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> (a -> a) -> m ()
unsafeModify (MArray l v) s f = GM.unsafeRead v i >>= GM.unsafeWrite v i . f
where i = shapeToIndex l s
{-# INLINE unsafeModify #-}
-- | Replace the element at the give position and return the old
-- element.
-unsafeExchange :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m a
+unsafeExchange :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m a
unsafeExchange (MArray l v) i a = GM.unsafeExchange v (shapeToIndex l i) a
{-# INLINE unsafeExchange #-}
-- | 'linearRead' without bounds checking.
-unsafeLinearRead :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> m a
+unsafeLinearRead :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> m a
unsafeLinearRead (MArray _ v) = GM.unsafeRead v
{-# INLINE unsafeLinearRead #-}
-- | 'linearWrite' without bounds checking.
-unsafeLinearWrite :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m ()
+unsafeLinearWrite :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m ()
unsafeLinearWrite (MArray _ v) = GM.unsafeWrite v
{-# INLINE unsafeLinearWrite #-}
-- | 'linearSwap' without bounds checking.
-unsafeLinearSwap :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> Int -> m ()
+unsafeLinearSwap :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> Int -> m ()
unsafeLinearSwap (MArray _ v) = GM.unsafeSwap v
{-# INLINE unsafeLinearSwap #-}
-- | 'linearModify' without bounds checking.
-unsafeLinearModify :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> (a -> a) -> m ()
+unsafeLinearModify :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> (a -> a) -> m ()
unsafeLinearModify (MArray _ v) i f = GM.unsafeRead v i >>= GM.unsafeWrite v i . f
{-# INLINE unsafeLinearModify #-}
-- | Replace the element at the give position and return the old
-- element.
-unsafeLinearExchange :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m a
+unsafeLinearExchange :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m a
unsafeLinearExchange (MArray _ v) i a = GM.unsafeExchange v i a
{-# INLINE unsafeLinearExchange #-}
-- Filling and copying -------------------------------------------------
-- | Set all elements in a mutable array to a constant value.
-set :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> a -> m ()
+set :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> a -> m ()
set (MArray _ v) = GM.set v
{-# INLINE set #-}
-- | Copy all elements from one array into another.
-copy :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> MArray v l (PrimState m) a -> m ()
+copy :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> MArray v f (PrimState m) a -> m ()
copy (MArray _ v) (MArray _ u) = GM.copy v u
{-# INLINE copy #-}
@@ -286,7 +286,7 @@ copy (MArray _ v) (MArray _ u) = GM.copy v u
-- Array v V1 a is essentially v a with a wrapper. Instance is provided
-- for convience.
-instance (MVector v a, l ~ V1) => MVector (MArray v l) a where
+instance (MVector v a, f ~ V1) => MVector (MArray v f) a where
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicOverlaps #-}
diff --git a/src/Data/Dense/TH.hs b/src/Data/Dense/TH.hs
index c327acb..e59b8a6 100644
--- a/src/Data/Dense/TH.hs
+++ b/src/Data/Dense/TH.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
@@ -60,6 +61,13 @@ import Data.Dense.Generic (empty, fromListInto_)
import Data.Dense.Index
import Data.Dense.Stencil
+tupe :: [Exp] -> Exp
+#if __GLASGOW_HASKELL__ <= 808
+tupe = TupE
+#else
+tupe = TupE . map Just
+#endif
+
-- | QuasiQuoter for producing a dense arrays using a custom parser.
-- Values are space separated, while also allowing infix expressions
-- (like @5/7@). If you want to apply a function, it should be done in
@@ -500,7 +508,7 @@ punc = \case
-- parenthesis / tuples
"(" -> do as <- expression `sepBy` comma
Lex.Punc ")" <- Lex.lex
- pure $ TupE as
+ pure $ tupe as
-- lists
"[" -> do as <- expression `sepBy` comma
Lex.Punc "]" <- Lex.lex
@@ -593,8 +601,8 @@ vTuple n
| otherwise = do
vN <- newName "v"
let idx i = AppE (AppE (VarE 'Vector.unsafeIndex) (VarE vN)) (intE i)
- let xs = TupE $ map idx [0..n-1]
- a <- newName "a"
+ let xs = tupe $ map idx [0..n-1]
+ a <- newName "a"
let tup = iterate (\x -> AppT x (VarT a)) (TupleT n) !! n
typ = ForallT [PlainTV a] []
(AppT (AppT ArrowT (AppT (AppT (ConT ''V.V) (intT n)) (VarT a))) tup)