Unboxed Vectors of newtype'd values

[Bas van Dijk]

On 4 June 2012 12:43, Simon Peyton-Jones <simonpj at microsoft.com> wrote:
> | I'd like some compiler support for abstracting over unboxed values in
> | general and e.g. generate Unbox instances automatically. Then we could
> | have other unboxed structures than Vector.
>
> Could someone post an example or two of the problem being described here?

The following is some boring code I wrote a while back at work for
storing UUIDs[1] in unboxed vectors:

{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}

import Control.Monad (liftM)
import Data.Word (Word32)

import Data.UUID (UUID)
import qualified Data.UUID as UUID

import qualified Data.Vector.Unboxed         as VU
import qualified Data.Vector.Generic         as VG
import qualified Data.Vector.Generic.Mutable as VGM

newtype instance VU.MVector s UUID =
	MV_UUID (VU.MVector s (Word32, Word32, Word32, Word32))

newtype instance  VU.Vector UUID =
	V_UUID (VU.Vector (Word32, Word32, Word32, Word32))

instance VU.Unbox UUID

instance VGM.MVector VU.MVector UUID where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength (MV_UUID v) =
    VGM.basicLength v

  basicUnsafeSlice i n (MV_UUID v) =
    MV_UUID $ VGM.basicUnsafeSlice i n v

  basicOverlaps (MV_UUID v1) (MV_UUID v2) =
    VGM.basicOverlaps v1 v2

  basicUnsafeNew n =
    MV_UUID `liftM` VGM.basicUnsafeNew n

  basicUnsafeReplicate n uuid =
    MV_UUID `liftM` VGM.basicUnsafeReplicate n (UUID.toWords uuid)

  basicUnsafeRead (MV_UUID v) i =
    fromQuadruple `liftM` VGM.basicUnsafeRead v i

  basicUnsafeWrite (MV_UUID v) i uuid =
    VGM.basicUnsafeWrite v i (UUID.toWords uuid)

  basicClear (MV_UUID v) =
    VGM.basicClear v

  basicSet (MV_UUID v) uuid =
    VGM.basicSet v (UUID.toWords uuid)

  basicUnsafeCopy (MV_UUID v1) (MV_UUID v2) =
    VGM.basicUnsafeCopy v1 v2

  basicUnsafeMove (MV_UUID v1) (MV_UUID v2) =
    VGM.basicUnsafeMove v1 v2

  basicUnsafeGrow (MV_UUID v) n =
    MV_UUID `liftM` VGM.basicUnsafeGrow v n

instance VG.Vector VU.Vector UUID where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze (MV_UUID v) =
    V_UUID `liftM` VG.basicUnsafeFreeze v

  basicUnsafeThaw (V_UUID v) =
    MV_UUID `liftM` VG.basicUnsafeThaw v

  basicLength (V_UUID v) =
    VG.basicLength v

  basicUnsafeSlice i n (V_UUID v) =
    V_UUID $ VG.basicUnsafeSlice i n v

  basicUnsafeIndexM (V_UUID v) i =
    fromQuadruple `liftM` VG.basicUnsafeIndexM v i

  basicUnsafeCopy (MV_UUID mv) (V_UUID v) =
    VG.basicUnsafeCopy mv v

  elemseq _ uuid z = VG.elemseq (undefined :: VU.Vector a) a
                   $ VG.elemseq (undefined :: VU.Vector a) b
                   $ VG.elemseq (undefined :: VU.Vector a) c
                   $ VG.elemseq (undefined :: VU.Vector a) d z
      where
        (a,b,c,d) = UUID.toWords uuid

fromQuadruple :: (Word32, Word32, Word32, Word32) -> UUID
fromQuadruple (a,b,c,d) = UUID.fromWords a b c d

Regards,

Bas

[1] http://hackage.haskell.org/packages/archive/uuid/1.2.5/doc/html/Data-UUID.html