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