Data/Array/IO/Internals.hs

   1 {-# OPTIONS -#include "HsBase.h" #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Data.Array.IO.Internal
   5 -- Copyright   :  (c) The University of Glasgow 2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable
  11 --
  12 -- Mutable boxed and unboxed arrays in the IO monad.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Data.Array.IO.Internals (
  17    IOArray(..),         -- instance of: Eq, Typeable
  18    IOUArray(..),        -- instance of: Eq, Typeable
  19    castIOUArray,        -- :: IOUArray ix a -> IO (IOUArray ix b)
  20  ) where
  21
  22 import Prelude
  23
  24 import Data.Array.MArray
  25 import Data.Int
  26 import Data.Word
  27 import Data.Dynamic
  28
  29 #ifdef __HUGS__
  30 import Hugs.IOArray
  31 #endif
  32
  33 import Control.Monad.ST         ( RealWorld, stToIO )
  34 import Foreign.Ptr              ( Ptr, FunPtr )
  35 import Foreign.StablePtr        ( StablePtr )
  36 import Data.Array.Base
  37
  38 #ifdef __GLASGOW_HASKELL__
  39 import GHC.IOBase
  40 import GHC.Base
  41 #endif /* __GLASGOW_HASKELL__ */
  42
  43 iOArrayTc :: TyCon
  44 iOArrayTc = mkTyCon "IOArray"
  45
  46 instance (Typeable a, Typeable b) => Typeable (IOArray a b) where
  47   typeOf a = mkAppTy iOArrayTc [typeOf ((undefined :: IOArray a b -> a) a),
  48                                 typeOf ((undefined :: IOArray a b -> b) a)]
  49
  50 -----------------------------------------------------------------------------
  51 -- | Instance declarations for 'IOArray's
  52
  53 #ifdef __GLASGOW_HASKELL__
  54 instance HasBounds IOArray where
  55     {-# INLINE bounds #-}
  56     bounds (IOArray marr) = bounds marr
  57 #endif
  58
  59 #ifdef __HUGS__
  60 instance HasBounds IOArray where
  61     bounds      = boundsIOArray
  62 #endif
  63
  64 instance MArray IOArray e IO where
  65     newArray    = newIOArray
  66     unsafeRead  = unsafeReadIOArray
  67     unsafeWrite = unsafeWriteIOArray
  68
  69 -----------------------------------------------------------------------------
  70 -- Flat unboxed mutable arrays (IO monad)
  71
  72 -- | Mutable, unboxed, strict arrays in the 'IO' monad.  The type
  73 -- arguments are as follows:
  74 --
  75 --  * @i@: the index type of the array (should be an instance of @Ix@)
  76 --
  77 --  * @e@: the element type of the array.  Only certain element types
  78 --    are supported: see 'MArray' for a list of instances.
  79 --
  80 newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
  81
  82 iOUArrayTc :: TyCon
  83 iOUArrayTc = mkTyCon "IOUArray"
  84
  85 instance (Typeable a, Typeable b) => Typeable (IOUArray a b) where
  86   typeOf a = mkAppTy iOUArrayTc [typeOf ((undefined :: IOUArray a b -> a) a),
  87                                  typeOf ((undefined :: IOUArray a b -> b) a)]
  88
  89 instance HasBounds IOUArray where
  90     {-# INLINE bounds #-}
  91     bounds (IOUArray marr) = bounds marr
  92
  93 instance MArray IOUArray Bool IO where
  94     {-# INLINE newArray #-}
  95     newArray lu init = stToIO $ do
  96         marr <- newArray lu init; return (IOUArray marr)
  97     {-# INLINE newArray_ #-}
  98     newArray_ lu = stToIO $ do
  99         marr <- newArray_ lu; return (IOUArray marr)
 100     {-# INLINE unsafeRead #-}
 101     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 102     {-# INLINE unsafeWrite #-}
 103     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 104
 105 instance MArray IOUArray Char IO where
 106     {-# INLINE newArray #-}
 107     newArray lu init = stToIO $ do
 108         marr <- newArray lu init; return (IOUArray marr)
 109     {-# INLINE newArray_ #-}
 110     newArray_ lu = stToIO $ do
 111         marr <- newArray_ lu; return (IOUArray marr)
 112     {-# INLINE unsafeRead #-}
 113     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 114     {-# INLINE unsafeWrite #-}
 115     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 116
 117 instance MArray IOUArray Int IO where
 118     {-# INLINE newArray #-}
 119     newArray lu init = stToIO $ do
 120         marr <- newArray lu init; return (IOUArray marr)
 121     {-# INLINE newArray_ #-}
 122     newArray_ lu = stToIO $ do
 123         marr <- newArray_ lu; return (IOUArray marr)
 124     {-# INLINE unsafeRead #-}
 125     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 126     {-# INLINE unsafeWrite #-}
 127     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 128
 129 #ifdef __GLASGOW_HASKELL__
 130 instance MArray IOUArray Word IO where
 131     {-# INLINE newArray #-}
 132     newArray lu init = stToIO $ do
 133         marr <- newArray lu init; return (IOUArray marr)
 134     {-# INLINE newArray_ #-}
 135     newArray_ lu = stToIO $ do
 136         marr <- newArray_ lu; return (IOUArray marr)
 137     {-# INLINE unsafeRead #-}
 138     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 139     {-# INLINE unsafeWrite #-}
 140     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 141 #endif
 142
 143 instance MArray IOUArray (Ptr a) IO where
 144     {-# INLINE newArray #-}
 145     newArray lu init = stToIO $ do
 146         marr <- newArray lu init; return (IOUArray marr)
 147     {-# INLINE newArray_ #-}
 148     newArray_ lu = stToIO $ do
 149         marr <- newArray_ lu; return (IOUArray marr)
 150     {-# INLINE unsafeRead #-}
 151     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 152     {-# INLINE unsafeWrite #-}
 153     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 154
 155 instance MArray IOUArray (FunPtr a) IO where
 156     {-# INLINE newArray #-}
 157     newArray lu init = stToIO $ do
 158         marr <- newArray lu init; return (IOUArray marr)
 159     {-# INLINE newArray_ #-}
 160     newArray_ lu = stToIO $ do
 161         marr <- newArray_ lu; return (IOUArray marr)
 162     {-# INLINE unsafeRead #-}
 163     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 164     {-# INLINE unsafeWrite #-}
 165     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 166
 167 instance MArray IOUArray Float IO where
 168     {-# INLINE newArray #-}
 169     newArray lu init = stToIO $ do
 170         marr <- newArray lu init; return (IOUArray marr)
 171     {-# INLINE newArray_ #-}
 172     newArray_ lu = stToIO $ do
 173         marr <- newArray_ lu; return (IOUArray marr)
 174     {-# INLINE unsafeRead #-}
 175     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 176     {-# INLINE unsafeWrite #-}
 177     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 178
 179 instance MArray IOUArray Double IO where
 180     {-# INLINE newArray #-}
 181     newArray lu init = stToIO $ do
 182         marr <- newArray lu init; return (IOUArray marr)
 183     {-# INLINE newArray_ #-}
 184     newArray_ lu = stToIO $ do
 185         marr <- newArray_ lu; return (IOUArray marr)
 186     {-# INLINE unsafeRead #-}
 187     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 188     {-# INLINE unsafeWrite #-}
 189     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 190
 191 instance MArray IOUArray (StablePtr a) IO where
 192     {-# INLINE newArray #-}
 193     newArray lu init = stToIO $ do
 194         marr <- newArray lu init; return (IOUArray marr)
 195     {-# INLINE newArray_ #-}
 196     newArray_ lu = stToIO $ do
 197         marr <- newArray_ lu; return (IOUArray marr)
 198     {-# INLINE unsafeRead #-}
 199     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 200     {-# INLINE unsafeWrite #-}
 201     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 202
 203 instance MArray IOUArray Int8 IO where
 204     {-# INLINE newArray #-}
 205     newArray lu init = stToIO $ do
 206         marr <- newArray lu init; return (IOUArray marr)
 207     {-# INLINE newArray_ #-}
 208     newArray_ lu = stToIO $ do
 209         marr <- newArray_ lu; return (IOUArray marr)
 210     {-# INLINE unsafeRead #-}
 211     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 212     {-# INLINE unsafeWrite #-}
 213     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 214
 215 instance MArray IOUArray Int16 IO where
 216     {-# INLINE newArray #-}
 217     newArray lu init = stToIO $ do
 218         marr <- newArray lu init; return (IOUArray marr)
 219     {-# INLINE newArray_ #-}
 220     newArray_ lu = stToIO $ do
 221         marr <- newArray_ lu; return (IOUArray marr)
 222     {-# INLINE unsafeRead #-}
 223     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 224     {-# INLINE unsafeWrite #-}
 225     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 226
 227 instance MArray IOUArray Int32 IO where
 228     {-# INLINE newArray #-}
 229     newArray lu init = stToIO $ do
 230         marr <- newArray lu init; return (IOUArray marr)
 231     {-# INLINE newArray_ #-}
 232     newArray_ lu = stToIO $ do
 233         marr <- newArray_ lu; return (IOUArray marr)
 234     {-# INLINE unsafeRead #-}
 235     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 236     {-# INLINE unsafeWrite #-}
 237     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 238
 239 instance MArray IOUArray Int64 IO where
 240     {-# INLINE newArray #-}
 241     newArray lu init = stToIO $ do
 242         marr <- newArray lu init; return (IOUArray marr)
 243     {-# INLINE newArray_ #-}
 244     newArray_ lu = stToIO $ do
 245         marr <- newArray_ lu; return (IOUArray marr)
 246     {-# INLINE unsafeRead #-}
 247     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 248     {-# INLINE unsafeWrite #-}
 249     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 250
 251 instance MArray IOUArray Word8 IO where
 252     {-# INLINE newArray #-}
 253     newArray lu init = stToIO $ do
 254         marr <- newArray lu init; return (IOUArray marr)
 255     {-# INLINE newArray_ #-}
 256     newArray_ lu = stToIO $ do
 257         marr <- newArray_ lu; return (IOUArray marr)
 258     {-# INLINE unsafeRead #-}
 259     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 260     {-# INLINE unsafeWrite #-}
 261     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 262
 263 instance MArray IOUArray Word16 IO where
 264     {-# INLINE newArray #-}
 265     newArray lu init = stToIO $ do
 266         marr <- newArray lu init; return (IOUArray marr)
 267     {-# INLINE newArray_ #-}
 268     newArray_ lu = stToIO $ do
 269         marr <- newArray_ lu; return (IOUArray marr)
 270     {-# INLINE unsafeRead #-}
 271     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 272     {-# INLINE unsafeWrite #-}
 273     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 274
 275 instance MArray IOUArray Word32 IO where
 276     {-# INLINE newArray #-}
 277     newArray lu init = stToIO $ do
 278         marr <- newArray lu init; return (IOUArray marr)
 279     {-# INLINE newArray_ #-}
 280     newArray_ lu = stToIO $ do
 281         marr <- newArray_ lu; return (IOUArray marr)
 282     {-# INLINE unsafeRead #-}
 283     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 284     {-# INLINE unsafeWrite #-}
 285     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 286
 287 instance MArray IOUArray Word64 IO where
 288     {-# INLINE newArray #-}
 289     newArray lu init = stToIO $ do
 290         marr <- newArray lu init; return (IOUArray marr)
 291     {-# INLINE newArray_ #-}
 292     newArray_ lu = stToIO $ do
 293         marr <- newArray_ lu; return (IOUArray marr)
 294     {-# INLINE unsafeRead #-}
 295     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 296     {-# INLINE unsafeWrite #-}
 297     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 298
 299 -- | Casts an 'IOUArray' with one element type into one with a
 300 -- different element type.  All the elements of the resulting array
 301 -- are undefined (unless you know what you\'re doing...).
 302 castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
 303 castIOUArray (IOUArray marr) = stToIO $ do
 304     marr' <- castSTUArray marr
 305     return (IOUArray marr')