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