[Haskell-cafe] bytestring vs. uvector

[Don Stewart]

bulat.ziganshin:
> Hello Don,
> 
> Wednesday, March 11, 2009, 12:12:07 AM, you wrote:
> 
> > Right, so my point stands: there's no difference now. If you can write a
> > Storable instance, you can write a UA et al instance.
> 
> yes, if there is some class provided for this and not just hard-coded
> 4 or so base types 

That's right. For example (supporting even pairs):

    instance (RealFloat a, UA a) => UA (Complex a) where

      newtype UArr  (Complex a)   = UAComplex  (UArr (a :*: a))
      newtype MUArr (Complex a) s = MUAComplex (MUArr (a :*: a) s)

> > And GHC 6.6 was released what, 11 October 2006? So this has been the
> > case for a long time.
> 
> unfortunately, Array library unboxed arrays still aren't based on any
> Unboxable *class*


Hmm. Aren't all the array library types based on MArray and IArray?

So I can define my own say, new STUArray element type by writing an instance of
MArray for it.  Like so:


    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE MagicHash             #-}
    {-# LANGUAGE UnboxedTuples         #-}
    {-# LANGUAGE CPP                   #-}

    -- get at low level representation stuff

    import Data.Array.Base
    import GHC.IOBase
    import GHC.ST       ( ST(..), runST )
    import GHC.Prim
    import GHC.Base
    import GHC.Word
    import GHC.Ptr
    import GHC.Float
    import GHC.Stable
    import GHC.Int
    import GHC.Word
    import Data.Array.Unboxed

    -- helpers

    import Data.Bits
    import Text.Printf
    import System.Environment
    import Control.Monad

    -- portable to 32 bit or 64 bit

    #include <MachDeps.h>

    -- define a new data type we wish to store in unboxed arrays

    data Boolean = IsTrue | IsFalse
        deriving (Eq, Ord, Enum, Show, Bounded)

    -- write a program using an unboxed array of these things

    main = do
        n <- getArgs >>= readIO . head :: IO Int
        mapM_ (\i -> sieve (10000 `shiftL` (n-i))) [0, 1, 2]

    -- Nsieve with bit packing of a custom MyBool type.
    sieve n = do
       let r = runST (do a <- newArray (2,n) IsTrue :: ST s (STUArray s Int Boolean)
                         go a n 2 0)
       printf "Primes up to %8d %8d\n" (n::Int) (r::Int) :: IO ()

    go !a !}m !n !c
        | n == m    = return c
        | otherwise = do
              e <- unsafeRead a n
              if e == IsTrue
                   then let loop j
                              | j < m     = do
                                  x <- unsafeRead a j
                                  when (x == IsTrue) $ unsafeWrite a j IsFalse
                                  loop (j+n)

                              | otherwise = go a m (n+1) (c+1)
                        in loop (n `shiftL` 1)
                   else go a m (n+1) c

    --
    -- Create a new unboxed representation for MyBool
    -- We choose to use bit packing, storing them in a W#
    --

    instance MArray (STUArray s) Boolean (ST s) where

        getBounds (STUArray l u _ _)      = return (l,u)
        getNumElements (STUArray _ _ n _) = return n

        newArray (l,u) initialValue = ST $ \s1# ->
            case safeRangeSize (l,u)            of { n@(I# n#) ->
            case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
            case bOOL_WORD_SCALE n#         of { n'# ->
            let loop i# s3# | i# ==# n'# = s3#
                            | otherwise  =
                    case writeWordArray# marr# i# e# s3# of { s4# ->
                    loop (i# +# 1#) s4# } in
            case loop 0# s2#                of { s3# ->
            (# s3#, STUArray l u n marr# #) }}}}
          where
            W# e# = if initialValue == IsTrue then maxBound else 0

        unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE

        newArray_ arrBounds = newArray arrBounds IsFalse

        unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
            case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
            (# s2#, case (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# of True -> IsTrue ; _ -> IsFalse #) }

        unsafeWrite (STUArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->
            case bOOL_INDEX i#              of { j# ->
            case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
            case if e == IsTrue then old# `or#` bOOL_BIT i#
                 else old# `and#` bOOL_NOT_BIT i# of { e# ->
            case writeWordArray# marr# j# e# s2# of { s3# ->
            (# s3#, () #) }}}}