Ticket #3181: Vector.hs

{-# LANGUAGE TypeFamilies, TypeOperators, MagicHash, UnboxedTuples #-}

module Data.Array.Vector (UA(..), (:*:)(..)) where

import Control.Monad.ST

import GHC.ST
import GHC.Prim
import GHC.Exts

data a :*: b = !a :*: !b

class UA e where
  data MUArr e :: * -> *
  newMU    :: Int -> ST s (MUArr e s)
  lengthMU :: MUArr e s -> Int
  readMU   :: MUArr e s -> Int -> ST s e
  writeMU  :: MUArr e s -> Int -> e -> ST s ()

instance UA Int where
  data MUArr Int s = IArr {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray# s)
  
  {-# INLINE newMU #-}
  newMU i@(I# i#) = ST (\s -> case newByteArray# (i# *# 4#) s of
                              (# s', arr #) -> (# s', IArr i arr #))
  
  {-# INLINE lengthMU #-}
  lengthMU (IArr i _) = i
  
  {-# INLINE readMU #-}
  readMU (IArr _ arr) (I# i#) = ST (\s -> case readIntArray# arr i# s of
                                          (# s', j# #) -> (# s', I# j# #))
  
  {-# INLINE writeMU #-}
  writeMU (IArr _ arr) (I# i#) (I# j#) = ST (\s -> case writeIntArray# arr i# j# s of
                                                   s' -> (# s', () #))