Remove Control.Parallel*, now in package parallel
[packages/random.git] / Data / Array / IO / Internals.hs
index ec930f2..fca542e 100644 (file)
@@ -1,4 +1,4 @@
-{-# OPTIONS -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -#include "HsBase.h" #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Array.IO.Internal
@@ -7,15 +7,17 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable
+-- Portability :  non-portable (uses Data.Array.Base)
 --
 -- Mutable boxed and unboxed arrays in the IO monad.
 --
 -----------------------------------------------------------------------------
 
+-- #hide
 module Data.Array.IO.Internals (
    IOArray(..),                -- instance of: Eq, Typeable
    IOUArray(..),       -- instance of: Eq, Typeable
+   castIOUArray,       -- :: IOUArray ix a -> IO (IOUArray ix b)
  ) where
 
 import Prelude
@@ -23,71 +25,39 @@ import Prelude
 import Data.Array.MArray
 import Data.Int
 import Data.Word
-import Data.Dynamic
+import Data.Typeable
 
 #ifdef __HUGS__
 import Hugs.IOArray
-import Hugs.IOExts             ( unsafeCoerce )
-import Data.Array.Storable
 #endif
 
-#ifdef __GLASGOW_HASKELL__
+import Control.Monad.ST                ( RealWorld, stToIO )
 import Foreign.Ptr             ( Ptr, FunPtr )
 import Foreign.StablePtr       ( StablePtr )
 import Data.Array.Base
 
-import GHC.Arr                 ( STArray )
+#ifdef __GLASGOW_HASKELL__
 import GHC.IOBase
 import GHC.Base
 #endif /* __GLASGOW_HASKELL__ */
 
-#ifdef __HUGS__
-instance HasBounds IOArray where
-    bounds = boundsIOArray
-
-instance MArray IOArray e IO where
-    newArray    = newIOArray
-    unsafeRead  = unsafeReadIOArray
-    unsafeWrite = unsafeWriteIOArray
-
-type IOUArray = StorableArray
-#endif /* __HUGS__ */
-
-iOArrayTc :: TyCon
-iOArrayTc = mkTyCon "IOArray"
+#include "Typeable.h"
 
-instance (Typeable a, Typeable b) => Typeable (IOArray a b) where
-  typeOf a = mkAppTy iOArrayTc [typeOf ((undefined :: IOArray a b -> a) a),
-                               typeOf ((undefined :: IOArray a b -> b) a)]
-
-#ifdef __GLASGOW_HASKELL__
--- GHC only to the end of file
+INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
 
 -----------------------------------------------------------------------------
--- | Mutable, boxed, non-strict arrays in the 'IO' monad.  The type
--- arguments are as follows:
---
---  * @i@: the index type of the array (should be an instance of @Ix@)
---
---  * @e@: the element type of the array.
---
-newtype IOArray i e = IOArray (STArray RealWorld i e) deriving Eq
-
-instance HasBounds IOArray where
-    {-# INLINE bounds #-}
-    bounds (IOArray marr) = bounds marr
+-- | Instance declarations for 'IOArray's
 
 instance MArray IOArray e IO where
-    {-# INLINE newArray #-}
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOArray marr)
-    {-# INLINE newArray_ #-}
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOArray marr)
-    {-# INLINE unsafeRead #-}
-    unsafeRead (IOArray marr) i = stToIO (unsafeRead marr i)
-    {-# INLINE unsafeWrite #-}
-    unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
+#if defined(__HUGS__)
+    getBounds   = return . boundsIOArray
+#elif defined(__GLASGOW_HASKELL__)
+    {-# INLINE getBounds #-}
+    getBounds (IOArray marr) = stToIO $ getBounds marr
+#endif
+    newArray    = newIOArray
+    unsafeRead  = unsafeReadIOArray
+    unsafeWrite = unsafeWriteIOArray
 
 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (IO monad)
@@ -95,25 +65,18 @@ instance MArray IOArray e IO where
 -- | Mutable, unboxed, strict arrays in the 'IO' monad.  The type
 -- arguments are as follows:
 --
---  * @i@: the index type of the array (should be an instance of @Ix@)
+--  * @i@: the index type of the array (should be an instance of 'Ix')
 --
 --  * @e@: the element type of the array.  Only certain element types
---    are supported: see 'MArray' for a list of instances.
+--    are supported: see "Data.Array.MArray" for a list of instances.
 --
-newtype IOUArray i e = IOUArray (STUArray RealWorld i e) deriving Eq
-
-iOUArrayTc :: TyCon
-iOUArrayTc = mkTyCon "IOUArray"
+newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
 
-instance (Typeable a, Typeable b) => Typeable (IOUArray a b) where
-  typeOf a = mkAppTy iOUArrayTc [typeOf ((undefined :: IOUArray a b -> a) a),
-                                typeOf ((undefined :: IOUArray a b -> b) a)]
-
-instance HasBounds IOUArray where
-    {-# INLINE bounds #-}
-    bounds (IOUArray marr) = bounds marr
+INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")
 
 instance MArray IOUArray Bool IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -126,6 +89,8 @@ instance MArray IOUArray Bool IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Char IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -138,6 +103,8 @@ instance MArray IOUArray Char IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -150,6 +117,8 @@ instance MArray IOUArray Int IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -162,6 +131,8 @@ instance MArray IOUArray Word IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray (Ptr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -174,6 +145,8 @@ instance MArray IOUArray (Ptr a) IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray (FunPtr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -186,6 +159,8 @@ instance MArray IOUArray (FunPtr a) IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Float IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -198,6 +173,8 @@ instance MArray IOUArray Float IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Double IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -210,6 +187,8 @@ instance MArray IOUArray Double IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray (StablePtr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -222,6 +201,8 @@ instance MArray IOUArray (StablePtr a) IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int8 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -234,6 +215,8 @@ instance MArray IOUArray Int8 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int16 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -246,6 +229,8 @@ instance MArray IOUArray Int16 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int32 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -258,6 +243,8 @@ instance MArray IOUArray Int32 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int64 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -270,6 +257,8 @@ instance MArray IOUArray Int64 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word8 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -282,6 +271,8 @@ instance MArray IOUArray Word8 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word16 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -294,6 +285,8 @@ instance MArray IOUArray Word16 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word32 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -306,6 +299,8 @@ instance MArray IOUArray Word32 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word64 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -317,4 +312,11 @@ instance MArray IOUArray Word64 IO where
     {-# INLINE unsafeWrite #-}
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
-#endif /* __GLASGOW_HASKELL__ */
+-- | Casts an 'IOUArray' with one element type into one with a
+-- different element type.  All the elements of the resulting array
+-- are undefined (unless you know what you\'re doing...).
+castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
+castIOUArray (IOUArray marr) = stToIO $ do
+    marr' <- castSTUArray marr
+    return (IOUArray marr')
+