Skip to content
Snippets Groups Projects

Add `MINIMAL` pragma for `MArray`

Merged konsumlamm requested to merge konsumlamm/array:minimal into master
1 file
+ 4
3
Compare changes
  • Side-by-side
  • Inline
+ 4
3
@@ -834,10 +834,9 @@ same way as for 'IArray'), and also over the type of the monad, @m@,
@@ -834,10 +834,9 @@ same way as for 'IArray'), and also over the type of the monad, @m@,
in which the mutable array will be manipulated.
in which the mutable array will be manipulated.
-}
-}
class (Monad m) => MArray a e m where
class (Monad m) => MArray a e m where
-- | Returns the bounds of the array (lowest,highest).
-- | Returns the bounds of the array (lowest,highest)
getBounds :: Ix i => a i e -> m (i,i)
getBounds :: Ix i => a i e -> m (i,i)
-- | Returns the number of elements in the array
-- | Returns the number of elements in the array.
getNumElements :: Ix i => a i e -> m Int
getNumElements :: Ix i => a i e -> m Int
-- | Builds a new array, with every element initialised to the supplied
-- | Builds a new array, with every element initialised to the supplied
@@ -892,6 +891,8 @@ class (Monad m) => MArray a e m where
@@ -892,6 +891,8 @@ class (Monad m) => MArray a e m where
-- default initialisation with undefined values if we *do* know the
-- default initialisation with undefined values if we *do* know the
-- initial value and it is constant for all elements.
-- initial value and it is constant for all elements.
 
{-# MINIMAL getBounds, getNumElements, (newArray | unsafeNewArray_), unsafeRead, unsafeWrite #-}
 
instance MArray IOArray e IO where
instance MArray IOArray e IO where
{-# INLINE getBounds #-}
{-# INLINE getBounds #-}
getBounds (IOArray marr) = stToIO $ getBounds marr
getBounds (IOArray marr) = stToIO $ getBounds marr
Loading