Data/Array/IO.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  Data.Array.IO
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- $Id: IO.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
  12 --
  13 -- Mutable boxed/unboxed arrays in the IO monad.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Array.IO (
  18    module Data.Array.MArray,
  19    IOArray,             -- instance of: Eq, Typeable
  20    IOUArray,            -- instance of: Eq, Typeable
  21    castIOUArray,        -- :: IOUArray i a -> IO (IOUArray i b)
  22  ) where
  23
  24 import Prelude
  25
  26 import Data.Array               ( Array )
  27 import Data.Array.MArray
  28 import Data.Int
  29 import Data.Word
  30 import Data.Dynamic
  31
  32 import Foreign.Ptr              ( Ptr, FunPtr )
  33 import Foreign.StablePtr        ( StablePtr )
  34
  35 #ifdef __GLASGOW_HASKELL__
  36 -- GHC only to the end of file
  37
  38 import Data.Array.Base
  39 import GHC.Arr          ( STArray, freezeSTArray, unsafeFreezeSTArray,
  40                           thawSTArray, unsafeThawSTArray )
  41
  42 import GHC.ST           ( ST(..) )
  43 import GHC.IOBase       ( stToIO )
  44
  45 import GHC.Base
  46
  47 -----------------------------------------------------------------------------
  48 -- Polymorphic non-strict mutable arrays (IO monad)
  49
  50 newtype IOArray i e = IOArray (STArray RealWorld i e) deriving Eq
  51
  52 iOArrayTc :: TyCon
  53 iOArrayTc = mkTyCon "IOArray"
  54
  55 instance (Typeable a, Typeable b) => Typeable (IOArray a b) where
  56   typeOf a = mkAppTy iOArrayTc [typeOf ((undefined :: IOArray a b -> a) a),
  57                                 typeOf ((undefined :: IOArray a b -> b) a)]
  58
  59 instance HasBounds IOArray where
  60     {-# INLINE bounds #-}
  61     bounds (IOArray marr) = bounds marr
  62
  63 instance MArray IOArray e IO where
  64     {-# INLINE newArray #-}
  65     newArray lu init = stToIO $ do
  66         marr <- newArray lu init; return (IOArray marr)
  67     {-# INLINE newArray_ #-}
  68     newArray_ lu = stToIO $ do
  69         marr <- newArray_ lu; return (IOArray marr)
  70     {-# INLINE unsafeRead #-}
  71     unsafeRead (IOArray marr) i = stToIO (unsafeRead marr i)
  72     {-# INLINE unsafeWrite #-}
  73     unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
  74
  75 -----------------------------------------------------------------------------
  76 -- Flat unboxed mutable arrays (IO monad)
  77
  78 newtype IOUArray i e = IOUArray (STUArray RealWorld i e) deriving Eq
  79
  80 iOUArrayTc :: TyCon
  81 iOUArrayTc = mkTyCon "IOUArray"
  82
  83 instance (Typeable a, Typeable b) => Typeable (IOUArray a b) where
  84   typeOf a = mkAppTy iOUArrayTc [typeOf ((undefined :: IOUArray a b -> a) a),
  85                                  typeOf ((undefined :: IOUArray a b -> b) a)]
  86
  87 instance HasBounds IOUArray where
  88     {-# INLINE bounds #-}
  89     bounds (IOUArray marr) = bounds marr
  90
  91 instance MArray IOUArray Bool IO where
  92     {-# INLINE newArray #-}
  93     newArray lu init = stToIO $ do
  94         marr <- newArray lu init; return (IOUArray marr)
  95     {-# INLINE newArray_ #-}
  96     newArray_ lu = stToIO $ do
  97         marr <- newArray_ lu; return (IOUArray marr)
  98     {-# INLINE unsafeRead #-}
  99     unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
 100     {-# INLINE unsafeWrite #-}
 101     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 102
 103 instance MArray IOUArray Char 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 Int 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 Word 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 (Ptr a) 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 (FunPtr 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 Float 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 Double 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 (StablePtr a) 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 Int8 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 Int16 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 Int32 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 Int64 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 Word8 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 Word16 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 Word32 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 Word64 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 -----------------------------------------------------------------------------
 296 -- Freezing
 297
 298 freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
 299 freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)
 300
 301 freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
 302 freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
 303
 304 {-# RULES
 305 "freeze/IOArray"  freeze = freezeIOArray
 306 "freeze/IOUArray" freeze = freezeIOUArray
 307     #-}
 308
 309 {-# INLINE unsafeFreezeIOArray #-}
 310 unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)
 311 unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)
 312
 313 {-# INLINE unsafeFreezeIOUArray #-}
 314 unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
 315 unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
 316
 317 {-# RULES
 318 "unsafeFreeze/IOArray"  unsafeFreeze = unsafeFreezeIOArray
 319 "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
 320     #-}
 321
 322 -----------------------------------------------------------------------------
 323 -- Thawing
 324
 325 thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
 326 thawIOArray arr = stToIO $ do
 327     marr <- thawSTArray arr
 328     return (IOArray marr)
 329
 330 thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
 331 thawIOUArray arr = stToIO $ do
 332     marr <- thawSTUArray arr
 333     return (IOUArray marr)
 334
 335 {-# RULES
 336 "thaw/IOArray"  thaw = thawIOArray
 337 "thaw/IOUArray" thaw = thawIOUArray
 338     #-}
 339
 340 {-# INLINE unsafeThawIOArray #-}
 341 unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)
 342 unsafeThawIOArray arr = stToIO $ do
 343     marr <- unsafeThawSTArray arr
 344     return (IOArray marr)
 345
 346 {-# INLINE unsafeThawIOUArray #-}
 347 unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
 348 unsafeThawIOUArray arr = stToIO $ do
 349     marr <- unsafeThawSTUArray arr
 350     return (IOUArray marr)
 351
 352 {-# RULES
 353 "unsafeThaw/IOArray"  unsafeThaw = unsafeThawIOArray
 354 "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
 355     #-}
 356
 357 castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
 358 castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
 359
 360 castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
 361 castIOUArray (IOUArray marr) = stToIO $ do
 362     marr' <- castSTUArray marr
 363     return (IOUArray marr')
 364
 365 #endif /* __GLASGOW_HASKELL__ */