创建UArray的自定义实例

时间:2014-02-20 02:33:59

标签: arrays haskell unboxing

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

data Cell = Open | Blocked

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

1 个答案:

答案 0 :(得分:14)

This answer解释了为什么向量比阵列更好,所以我将为你提供未装箱的向量的答案。

我确实尝试根据MArray个实例为IArray派生CellBool个实例,但Bool个实例非常复杂;它至少与手动导出向量的Unbox实例一样难看。与向量不同,您也不能只导出Storable并使用Storable数组:您仍然需要MarrayIArray个实例。似乎还没有一个很好的TH解决方案,所以你最好还是出于这些原因使用向量。

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

  1. 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
    
  2. 编写您自己的UnboxM.MVectorV.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
    

    那不是很有趣吗?

  3. 创建Storable个实例并改为使用Data.Vector.Storable

    优点:没有TH,而且相对简单的实例

    缺点:实例不如TH定义明显。此外,每当你问一个关于Storable向量的SO问题时,有人会不可避免地问你为什么不使用Unboxed向量,尽管似乎没有人知道为什么Unboxed向量更好。< / p>

    对于数据:

    {-# 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)
    
  4. newtype

    的Unbox实例

    这并不直接适用于您的问题,因为您没有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