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