我正在使用Haskell生成和解析现有的二进制格式（Xilinx FPGA位文件）。目前我的数据结构和操作如下所示：
getCode = fromIntegral.fromEnum
getName = toEnum.fromIntegral
-- 1 1 1 1 1 1
-- 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-- MOD_REG -------------------------------
-- 0 0 0 0 0 0 0 0 0 N B B B 1 1 1
-- M M M M
-- 2 1 0
data NewMode = NoNewMode | NewMode deriving (Show, Eq, Enum)
data Bootmode = SerialM | SpiM | BpiUp | InternalM | ReservedMode
| Jtag | ParallelS | SerialS
deriving (Show, Eq, Enum)
modeCode :: NewMode -> Bootmode -> Word16
modeCode newmode bootmode = (shiftL (getCode newmode) 6) .|.
(shiftL (getCode bootmode) 3) .|. 0x7
codeMode :: Word16 -> (NewMode, Bootmode)
codeMode w = (getName $ shiftR w 6 .&. 0x0001,
getName $ shiftR w 3 .&. 0x0007)
对于设备中存在的每个不同配置寄存器字，我编写了一组非常相似的行（底部有更多示例）。只有AND掩码中的移位量和位数改变。我有一种感觉，应该以某种方式消除这种重复，这种重复很烦人，并且很容易找到错误。
我的第一个直觉是添加一个类型类“Bitfield”，每个单独的寄存器字（或者更确切地说，代表一个的数据类型）将是一个实例，并且这将允许我只输出结构的表示从那个单词和我可以以某种方式具有生成和解析的默认实现。我无法弄清楚如何弯曲标准类系统来做到这一点，但有一些类型系统扩展/泛型/存在/ ghc-extras的组合，最终将允许我用代码中的那些生成和解析函数替换
之类的东西class Bitfield t where
representation :: something
toBits :: t -> Int
fromBits :: Int -> t
toBits = something (using representation)
fromBits = something (using representation)
instance Bitfield ModReg where
representation = something
然后在我的使用中只需要使用bit和fromBits？不知何故，这看起来几乎与Ghc.Generics教程示例完全一样，将任意数据类型序列化为二进制。我仍然没有完全适应我的情况。
以下是其他寄存器的生成和解析函数的一些示例，以显示我正在讨论的重复。在实际的完整代码中还有更多。还要看看位置和字段长度是如何嵌入到函数中并在每个函数中重复的，将编译器无法捕获的错误机会加倍。
-- 1 1 1 1 1 1
-- 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-- CTL_REG -------------------------------
-- 0 0 0 0 0 0 0 0 E 0 S S P I 0 G
-- M B B E C T
-- 1 0 R P S
data EnMboot = DisMboot | EnMboot deriving (Show, Eq, Enum)
data Sbits = ReadWrite | IcapOnly | CrcOnly deriving (Show, Eq, Enum)
data Persist = NoPersist | Persist deriving (Show, Eq, Enum)
data Icap = NoIcap | Icap deriving (Show, Eq, Enum)
data GtsUserB = IoHighZ | IoActive deriving (Show, Eq, Enum)
ctlCode :: EnMboot -> Sbits -> Persist -> Icap -> GtsUserB -> Word16
ctlCode enmboot sbits persist icap gtsuserb =
(shiftL (getCode enmboot) 7) .|.
(shiftL (getCode sbits) 4) .|.
(shiftL (getCode persist) 3) .|.
(shiftL (getCode icap) 2) .|.
(getCode gtsuserb)
codeCtl :: Word16 -> (EnMboot,Sbits,Persist,Icap,GtsUserB)
codeCtl w =
(getName $ shiftR w 7 .&. 0x0001,
getName $ shiftR w 4 .&. 0x0003,
getName $ shiftR w 3 .&. 0x0001,
getName $ shiftR w 2 .&. 0x0001,
getName $ w .&. 0x0001)
-- 1 1 1 1 1 1
-- 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-- COR_REG1 -------------------------------
-- D 0 1 1 1 1 1 1 0 0 0 C D D S S
-- A R P D C C
-- C 1 0
data DriveAwake = OpenDrainAwake | DriveAwake deriving (Show, Eq, Enum)
data CrcBypass = CrcEnabled | CrcDisabled deriving (Show, Eq, Enum)
data DonePipe = NoDonePipe | DonePipe deriving (Show, Eq, Enum)
data DriveDone = OpenDrainDone | DriveDone deriving (Show, Eq, Enum)
data SsClkSrc = Cclk | UserClk | JtagClk deriving (Show, Eq, Enum)
cor1Code :: DriveAwake -> CrcBypass -> DonePipe -> DriveDone ->
SsClkSrc -> Word16
cor1Code driveawake crcbypass donepipe drivedone ssclksrc =
(shiftL (getCode driveawake) 15) .|.
0x2F00 .|.
(shiftL (getCode crcbypass) 4) .|.
(shiftL (getCode donepipe) 3) .|.
(shiftL (getCode drivedone) 2) .|.
(getCode ssclksrc)
codeCor1 :: Word16 -> (DriveAwake,CrcBypass,DonePipe,DriveDone,SsClkSrc)
codeCor1 w =
(getName $ shiftR w 15 .&. 0x0001,
getName $ shiftR w 4 .&. 0x0001,
getName $ shiftR w 3 .&. 0x0001,
getName $ shiftR w 2 .&. 0x0001,
getName $ w .&. 0x0003)
答案 0 :(得分：2)
我们将创建自己的库来读取和写入Bits的内容。它的结构很像二进制包或用于序列化泛型的示例代码。我们不会利用泛型，因为除了我们需要的类型之外，还有太多的额外信息，以便知道如何读取和写入值。我们将通过monadic reader读取数据，我们将从Free monad免费获取。
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor #-}
import Data.Word
import Data.Bits
import Control.Monad.Free
import Control.Applicative
import Data.Monoid
为了免费获得monad，我们需要定义一个基本仿函数来从位读取。 GetF是我们的基础函子。我们执行的唯一操作是Get（读取）多个位。这将为我们提供一些我们知道将包含Bits和Integral个实例的价值，我们需要从中确定下一步该做什么。
data GetF next = Get Int (forall b. (Bits b, Integral b) => b -> next)
deriving (Functor)
type Get = Free GetF
我们免费获得Get所需的所有实例。
在继续之前，我们将采用读取和写入该类型的最低有效位的约定。下一个要读取的位始终为位0，写入的最后一位始终为位0。
要运行get计算，我们需要以下小解释器。如果我们有Pure结果，我们会将其返回。当我们被指示要读取Get位时，我们屏蔽该位数并运行该函数以确定下一步要做什么。然后，我们运行生成的Get，其中许多位从右侧移开。
runGet :: (Bits b, Integral b) => b -> Get a -> a
runGet bits (Pure a) = a
runGet bits (Free (Get l f)) = runGet (shiftR bits l) $ f (bits .&. oneBits l)
oneBits使用1 s填充指定数量的最低有效位。
oneBits :: Bits b => Int -> b
oneBits n | n <= 0 = zeroBits
oneBits n = let (q, r) = n `quotRem` 2
bq = oneBits q
in bit 0 .|. shiftL (bq .|. shiftL bq q) r
当我们输入（写入）位时，我们需要提供要写入的位数以及具有Bits和Integeral个实例的任何类型的位。
data Put = Put Int (forall b. (Bits b, Integral b) => b)
当我们偏执地构建一个Put时，我们会在构建它时屏蔽这些位，以确保没有额外的位被放置在长度之外。
mkPut :: Int -> (forall b. (Bits b, Integral b) => b) -> Put
mkPut l bits = Put l (bits .&. oneBits l)
我们Put所需的唯一实例是Monoid，因此我们可以一个接一个地写一个。
instance Monoid Put where
mempty = Put 0 0
Put l1 bits1 `mappend` Put l2 bits2 = Put (l1 + l2) (bits1 .|. shiftL bits2 l1)
我们将编写一些辅助函数来构建Get和Put。您编码或解码的大多数数据都是各种位长的Enum。 getEnum将Get构建为Integral Bits到Enum。这基本上是你的getName包裹起来以及要获得多少比特。 putEnum将这些位包裹起来以及它们的长度。
getEnum :: Enum e => Int -> Get e
getEnum l = Free (Get l (Pure . toEnum . fromIntegral))
putEnum :: Enum e => Int -> e -> Put
putEnum l x = mkPut l (fromIntegral . fromEnum $ x)
在读取某些结构时，您还需要跳过位。 getSkip跳过位而不对它们做任何事情。 putSkip使用相同数量的0位; putSkip1使用相同数量的1位。
getSkip :: Int -> Get ()
getSkip l = Free (Get l (const (Pure ())))
putSkip :: Int -> Put
putSkip l = Put l 0
putSkip1 :: Int -> Put
putSkip1 l = Put l (oneBits l)
一开始，我们选择读取并写入最低位。由于这种惯例的选择，我们将首先使用最不重要的字段来创建数据类型。这是ModReg，代表MOD_REG结构。引导模式存储在较低有效位中，是结构中的第一个字段。
data ModReg = ModReg {bootmode :: Bootmode, newMode :: NewMode} deriving (Show, Eq)
data Bootmode = SerialM | SpiM | BpiUp | InternalM | ReservedMode
| Jtag | ParallelS | SerialS
deriving (Show, Eq, Enum)
data NewMode = NoNewMode | NewMode deriving (Show, Eq, Enum)
我将为可以写入Bits或从class Encodeable a where
put :: a -> Put
get :: Get a
读取的内容添加类型类，而不是因为我们想要使用类型类，而只是因此我不需要提出所有这些的名称。
ModReg我们现在可以先读取和写入ModReg结构最低有效位。第二行中使用instance Encodeable ModReg where
put mr = putSkip1 3 <> putEnum 3 (bootmode mr) <> putEnum 1 (newMode mr)
get = ModReg <$ getSkip 3 <*> getEnum 3 <*> getEnum 1
构造函数的技巧是为什么我将字段放在最低位的第一顺序。
Bits对于一个完整的，运行的例子，能够漂亮地打印import Data.List (intercalate)
showBitsN :: Bits b => Int -> b -> String
showBitsN n b = "[" ++ intercalate " " (map (\x -> if testBit b x then "1" else "0") [n,n-1..0]) ++ "]"
showBits :: FiniteBits b => b -> String
showBits b = showBitsN (finiteBitSize b) b
中的位是很好的。我们先用最重要的位打印它们。
ModReg我们的示例将在第3位到第5位中使用Jtag标记1 0 1并在位6中使用NewMode标记1生成Word16。我们' ll将其转换为main = do
let mr = ModReg Jtag NewMode
print mr
let x = runPut (put mr) :: Word16
putStrLn $ showBits x
let mr' = runGet x get :: ModReg
print mr'
然后再将其转换回来。
ModReg {bootmode = Jtag, newMode = NewMode}
111
[0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1]
ModReg {bootmode = Jtag, newMode = NewMode}
这会产生预期的输出
ModReg如果我们将两个Word32连续放入main = do
let (mr1, mr2) = (ModReg Jtag NewMode, ModReg BpiUp NoNewMode)
let x = runPut (put mr1 <> put mr2) :: Word32
print x
putStrLn $ showBits x
let mr' = runGet x (get >>= \a -> get >>= \b -> return (a, b)) :: (ModReg, ModReg)
print mr'
，我们会有点意外。
Word16而不是两个3055
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1]
(ModReg {bootmode = Jtag, newMode = NewMode},ModReg {bootmode = BpiUp, newMode = NoNewMode})
s彼此相邻，所有设置位都适合不到一半的空间。
get如果我们想以这种方式使用put和ModReg skip，我们需要为最高位添加instance Encodeable ModReg where
put mr = putSkip1 3 <> putEnum 3 (bootmode mr) <> putEnum 1 (newMode mr) <> putSkip 9
get = ModReg <$ getSkip 3 <*> getEnum 3 <*> getEnum 1 <* getSkip 9
。
ModReg现在1507439
[0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1]
(ModReg {bootmode = Jtag, newMode = NewMode},ModReg {bootmode = BpiUp, newMode = NoNewMode})
写入16位宽。
{{1}}