создания пользовательских экземпляра UArray

Question

Предположим, у меня есть простой тип данных, как:

data Cell = Open | Blocked 

, и я хотел бы использовать UArray Int Cell. Есть простой способ сделать это? Могу ли я как-то повторно использовать определение для UArray Int Bool?

Answer 1

This answer объясняет, почему векторы лучше, чем массивы, поэтому я дам вам ответ на нерасположенные векторы.

Я действительно пытался вывод MArray и IArray экземпляра для Cell на основе Bool экземпляров, но Bool экземпляров являются довольно сложными; он был бы по крайней мере столь же уродливым, как и вручную, для экземпляра Unbox для векторов. В отличие от векторов, вы также не можете просто получить Storable и использовать массивы Storable: вам все равно нужны экземпляры Marray и IArray. Похоже, что нет хорошего решения 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. Написать свой собственный 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 
   

   Разве это не было забавно?

3. Создайте экземпляр Storable и используйте вместо него Data.Vector.Storable.

   Плюсы: Нет TH, и относительно простые инстанции

   Минусы: Экземпляр менее очевиден, чем определение TH. Кроме того, всякий раз, когда вы задаете вопрос SO 0 относительно векторов Storable, кто-то неизбежно спросит, почему вы не используете векторы 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 
   

   Или для Newtype:

   {-# 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

   Это напрямую не распространяется на ваш вопрос, так как вы не есть newtype, но я включу его для полноты.

   Pros: Нет 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) 
   

   EDIT

   Обратите внимание, что в настоящее время isn't possible in GHC 7.8 это решение.