UArrays.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
{-# LANGUAGE MagicHash, UnboxedTuples #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE IncoherentInstances #-}


module UArrays where

import           Data.Array
import           Data.Array.Base
import           Data.Array.ST
import           Data.Array.Unboxed

import           GHC.Base -- (Int(I#), Int#(..))
import           GHC.Prim -- (indexIntArray#, readIntArray#, writeIntArray#)
import           GHC.ST (ST(..), runST)

-- Thanks, Stackoverflow!  http://stackoverflow.com/questions/8941386/

--instance (Enum a) => IArray UArray a where
instance (Enum a) => IArray UArray a where
    {-# INLINE bounds #-}
    bounds (UArray l u _ _) = (l, u)
    {-# INLINE numElements #-}
    numElements (UArray _ _ n _) = n
    {-# INLINE unsafeArray #-}
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies (toEnum 0))
    {-# INLINE unsafeAt #-}
    unsafeAt (UArray _ _ _ arr#) (I# i#) =
        toEnum $ I# (indexIntArray# arr# i#)
    {-# INLINE unsafeReplace #-}
    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
    {-# INLINE unsafeAccum #-}
    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
    {-# INLINE unsafeAccumArray #-}
    unsafeAccumArray f initialValue lu ies =
      runST (unsafeAccumArrayUArray f initialValue lu ies)
-- class Monad m => MArray a e m where
-- data STUArray s i e = STUArray !i !i !Int (GHC.Prim.MutableByteArray# s)
--                                         array  elem monad
instance (Enum a) => MArray (STUArray s) a (ST s) where
    {-# INLINE getBounds #-}
    getBounds (STUArray l u _ _) = return (l, u)
    {-# INLINE getNumElements #-}
    getNumElements (STUArray _ _ n _) = return n
    {-# INLINE unsafeNewArray_ #-}
    unsafeNewArray_ (l, u) = unsafeNewArraySTUArray_ (l, u) wORD_SCALE
    {-# INLINE newArray_ #-}
    newArray_ arrBounds = newArray arrBounds (toEnum 0)
    {-# INLINE unsafeRead #-}
    -- unsafeRead :: GHC.Arr.Ix i => a i e -> Int -> m e
    unsafeRead (STUArray _ _ _ marr#) (I# i#) =
      ST $ \ s1# ->
      case readIntArray# marr# i# s1# of
        (# s2#, e# #) -> (# s2#, (toEnum $ I# e#) #)
    {-# INLINE unsafeWrite #-}
    -- unsafeWrite :: GHC.Arr.Ix i => a i e -> Int -> e -> m ()
    unsafeWrite (STUArray _ _ _ marr#) (I# i#) enum =
      ST $ \ s1# ->
      case writeIntArray# marr# i# (unbox $ fromEnum enum) s1# of
        s2# -> (# s2#, () #)

{-# INLINE unbox #-}
unbox :: Int -> Int#
unbox = \ x -> case x of I# e# -> e#

{-# INLINE box #-}
box :: Int# -> Int
box = I#