arrays - 创建 UArray 的自定义实例

Question

假设我有一个简单的数据类型，例如:

data Cell = Open | Blocked

我想使用 UArray Int Cell .是否有捷径可寻？我可以以某种方式重用 UArray Int Bool 的定义吗？ ?

Answer 1

This answer解释了为什么 Vectors 比 Arrays 更好，所以我将为您提供未装箱向量的答案。

我确实尝试导出 MArray和 IArray Cell 的实例基于Bool实例，但 Bool实例相当复杂；它至少和手动导出 Unbox 一样难看。向量的例子。与向量不同，您也不能只推导出 Storable并使用 Storable数组:您仍然需要 Marray和 IArray实例。似乎还没有一个很好的 TH 解决方案，因此出于这些原因，您最好也使用向量。

有几种方法可以做到这一点，有些方法比其他方法更痛苦。

vector-th-unbox

优点:简单明了，比手动导出 Unbox 短得多实例

缺点:需要 -XTemplateHaskell

{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-}

import Data.Vector.Unboxed
import Data.Vector.Unboxed.Deriving
import qualified Data.Vector.Generic
import qualified Data.Vector.Generic.Mutable

data Cell = Open | Blocked deriving (Show)

derivingUnbox "Cell"
    [t| Cell -> Bool |]
    [| \ x -> case x of
        Open -> True
        Blocked -> False |]
    [| \ x -> case x of
        True -> Open
        False -> Blocked |]

main = print $ show $ singleton Open

写你自己的Unbox , M.MVector , 和 V.Vector实例，加上两个数据实例

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}

import qualified Data.Vector.Generic            as V
import qualified Data.Vector.Generic.Mutable    as M
import qualified Data.Vector.Unboxed            as U
import Control.Monad

data Cell = Open | Blocked deriving (Show)

data instance U.MVector s Cell = MV_Cell (U.MVector s Cell)
data instance U.Vector Cell = V_Cell (U.Vector Cell)

instance U.Unbox Cell

{- purloined and tweaked from code in `vector` 
   package that defines types as unboxed -}
instance M.MVector U.MVector Cell 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_Cell v) = M.basicLength v
  basicUnsafeSlice i n (MV_Cell v) = MV_Cell $ M.basicUnsafeSlice i n v
  basicOverlaps (MV_Cell v1) (MV_Cell v2) = M.basicOverlaps v1 v2
  basicUnsafeNew n = MV_Cell `liftM` M.basicUnsafeNew n
  basicUnsafeReplicate n x = MV_Cell `liftM` M.basicUnsafeReplicate n x
  basicUnsafeRead (MV_Cell v) i = M.basicUnsafeRead v i
  basicUnsafeWrite (MV_Cell v) i x = M.basicUnsafeWrite v i x
  basicClear (MV_Cell v) = M.basicClear v
  basicSet (MV_Cell v) x = M.basicSet v x
  basicUnsafeCopy (MV_Cell v1) (MV_Cell v2) = M.basicUnsafeCopy v1 v2
  basicUnsafeMove (MV_Cell v1) (MV_Cell v2) = M.basicUnsafeMove v1 v2
  basicUnsafeGrow (MV_Cell v) n = MV_Cell `liftM` M.basicUnsafeGrow v n

instance V.Vector U.Vector Cell where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}

  basicUnsafeFreeze (MV_Cell v) = V_Cell `liftM` V.basicUnsafeFreeze v
  basicUnsafeThaw (V_Cell v) = MV_Cell `liftM` V.basicUnsafeThaw v
  basicLength (V_Cell v) = V.basicLength v
  basicUnsafeSlice i n (V_Cell v) = V_Cell $ V.basicUnsafeSlice i n v
  basicUnsafeIndexM (V_Cell v) i = V.basicUnsafeIndexM v i
  basicUnsafeCopy (MV_Cell mv) (V_Cell v) = V.basicUnsafeCopy mv v
  elemseq _ = seq

main = print $ show $ U.singleton Open

那不是很有趣吗？

创建 Storable实例和使用Data.Vector.Storable反而。

优点:没有 TH，实例相对简单

缺点:实例不如 TH 定义明显。此外，每当您提出有关 Storable 的 SO 问题时，向量，有人会不可避免地问你为什么不使用 Unboxed向量，尽管似乎没有人知道为什么 Unboxed载体更好。

对于数据:

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Data.Vector.Storable
import Foreign.Storable

import GHC.Ptr
import GHC.Int

-- defined in HsBaseConfig.h as 
-- #define HTYPE_INT Int32
type HTYPE_INT = Int32

data Cell = Open | Blocked deriving (Show)

instance Storable Cell where
 sizeOf _          = sizeOf (undefined::HTYPE_INT)
 alignment _       = alignment (undefined::HTYPE_INT)
 peekElemOff p i   = liftM (\x -> case x of 
                        (0::HTYPE_INT) -> Blocked
                        otherwise -> Open) $ peekElemOff (castPtr p) i
 pokeElemOff p i x = pokeElemOff (castPtr p) i $ case x of
    Blocked -> 0
    Open -> (1 :: HTYPE_INT)

main = print $ show $ singleton Open

或者对于新类型:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Data.Vector.Storable as S
import Foreign.Storable

newtype Cell = IsOpen Bool deriving (Show)

main = print $ show $ S.singleton (Foo True)

为 newtype 拆箱实例

这并不直接适用于您的问题，因为您没有 newtype ，但为了完整起见，我将其包括在内。

优点:没有 TH，无需编写代码，仍在使用 Unboxed仇恨者的向量

缺点:没有？

{-# LANGUAGE GeneralizedNewtypeDeriving, 
             StandaloneDeriving, 
             MultiParamTypeClasses #-}

import Data.Vector.Generic as V
import Data.Vector.Generic.Mutable as M
import Data.Vector.Unboxed as U

newtype Cell = IsOpen Bool deriving (Unbox, Show)
deriving instance V.Vector U.Vector Cell
deriving instance M.MVector U.MVector Cell

main = print $ show $ U.singleton (IsOpen True)

编辑

请注意，此解决方案目前 isn't possible in GHC 7.8 .