您可以使用Data.Binary。
为所有涉及的数据类型派生Generic。这将需要-XDeriveGeneric pragma。如果您使用的外部库中的数据类型不这样做,您可能必须有一个orphan instances 的模块并使用-XStandaloneDeriving。
完成后,您可以使用Binary 类已经支持从Generic 派生的事实。您需要启用-XDeriveAnyclass,然后您可以为所有涉及的数据类型添加Binary 实例(您可能再次需要为外部库中的类型提供独立实例)。
编辑
OP added a gist。然后,要编译它,我们需要添加以下语言编译指示:
{-# LANGUAGE DeriveDataTypeable,
DeriveAnyClass,
DeriveGeneric,
StandaloneDeriving #-}
还有以下导入:
import Language.C.Syntax.AST
import Language.C.Data.Position
import Language.C.Data.Node
import Language.C.Data.Name
import Language.C.Data.Ident
import Language.C.Syntax.Constants
import Data.Data
import GHC.Generics
import Data.Binary
来自 OP 要点:
type CTypeSpecAnn = CTypeSpecifier NodeAnn
type CDeclAnn = CDeclaration NodeAnn
type CDeclSpecAnn = CDeclarationSpecifier NodeAnn
type CDeclrAnn = CDeclarator NodeAnn
type CStatAnn = CStatement NodeAnn
type CExtDeclAnn = CExternalDeclaration NodeAnn
type CExprAnn = CExpression NodeAnn
type CBlockItemAnn = CCompoundBlockItem NodeAnn
type CTranslUnitAnn = CTranslationUnit NodeAnn
data TransState =
TransState
{
free_node_id :: Int,
freeVar :: Int,
includes :: [String],
fun_defs :: [(String, (CTypeSpecAnn, [CDeclAnn], ([CDeclSpecAnn], CDeclrAnn, [CDeclAnn], NodeAnn)), CStatAnn)],
no_fun_defs :: [CExtDeclAnn],
last_changed :: String,
previous_changes :: ([(String, ((String,CStatAnn,CStatAnn), TransState, [(String, CStatAnn)]))], [(String, ((String,CExprAnn,CExprAnn), TransState, [(String, CStatAnn)]))]),
applied_rules :: [String],
applicable_rules :: Set String,
trans_with_anns :: Bool
}
deriving (Show, Data, Typeable)
type NodeAnn = Annotation NodeInfo NodeProperties
data Annotation nI nP = Ann nI nP
deriving (Show, Data, Typeable, Eq)
data NodeProperties =
NodeProperties
{
_hasSideEffects :: PropertyInfo Bool,
_readIn :: PropertyInfo [String],
_writeIn :: PropertyInfo [String],
_localSymbols :: PropertyInfo [String],
_rangeInfo :: PropertyInfo [String],
_isCanonical :: PropertyInfo Bool,
_isPerfectNest :: PropertyInfo Bool,
_hasLoops :: PropertyInfo Bool,
_hasFunctionCalls :: PropertyInfo Bool,
_hasControlFlowModifiers :: PropertyInfo Bool,
_scalarDependences :: PropertyInfo [String],
_polcaPragmas :: PropertyInfo [[String]],
_allPragmas :: PropertyInfo [String]
}
deriving (Show, Data, Typeable, Eq)
data PropertyInfo a =
PropertyInfo
{
_pragmaType :: PragmaType,
_definedBy :: DefinerType,
_value :: Maybe a
}
deriving (Show, Data, Typeable, Eq)
makeLenses ''NodeProperties
makeLenses ''PropertyInfo
由于 OP 从未定义 PragmaType 和 DefinerType,我假设它们是 ()。
type PragmaType = ()
type DefinerType = ()
然后我们有大量的deriving instance(我们必须递归地找到所有类型依赖项并将Generic 和Binary 添加到它们)。
deriving instance Generic (CDeclaration a)
deriving instance Binary a => Binary (CDeclaration a)
deriving instance Generic (CTypeSpecifier a)
deriving instance Binary a => Binary (CTypeSpecifier a)
deriving instance Generic (CDeclarationSpecifier a)
deriving instance Binary a => Binary (CDeclarationSpecifier a)
deriving instance Generic (CDeclarator a)
deriving instance Binary a => Binary (CDeclarator a)
deriving instance Generic (CStatement a)
deriving instance Binary a => Binary (CStatement a)
deriving instance Generic (CExternalDeclaration a)
deriving instance Binary a => Binary (CExternalDeclaration a)
deriving instance Generic (CExpression a)
deriving instance Binary a => Binary (CExpression a)
deriving instance Generic (CCompoundBlockItem a)
deriving instance Binary a => Binary (CCompoundBlockItem a)
deriving instance Generic (CTranslationUnit a)
deriving instance Binary a => Binary (CTranslationUnit a)
deriving instance Generic (CInitializer a)
deriving instance Binary a => Binary (CInitializer a)
deriving instance Generic (CStructureUnion a)
deriving instance Binary a => Binary (CStructureUnion a)
deriving instance Generic (CTypeQualifier a)
deriving instance Binary a => Binary (CTypeQualifier a)
deriving instance Generic (CStringLiteral a)
deriving instance Binary a => Binary (CStringLiteral a)
deriving instance Generic (CAttribute a)
deriving instance Binary a => Binary (CAttribute a)
deriving instance Generic (CPartDesignator a)
deriving instance Binary a => Binary (CPartDesignator a)
deriving instance Generic (CFunctionDef a)
deriving instance Binary a => Binary (CFunctionDef a)
deriving instance Generic (CAssemblyStatement a)
deriving instance Binary a => Binary (CAssemblyStatement a)
deriving instance Generic (CAssemblyOperand a)
deriving instance Binary a => Binary (CAssemblyOperand a)
deriving instance Generic (CConstant a)
deriving instance Binary a => Binary (CConstant a)
deriving instance Generic (CEnumeration a)
deriving instance Binary a => Binary (CEnumeration a)
deriving instance Generic (CStorageSpecifier a)
deriving instance Binary a => Binary (CStorageSpecifier a)
deriving instance Generic (CDerivedDeclarator a)
deriving instance Binary a => Binary (CDerivedDeclarator a)
deriving instance Generic (CBuiltinThing a)
deriving instance Binary a => Binary (CBuiltinThing a)
deriving instance Generic (CArraySize a)
deriving instance Binary a => Binary (CArraySize a)
deriving instance Generic (Flags a)
deriving instance Binary a => Binary (Flags a)
deriving instance Generic NodeInfo
deriving instance Binary NodeInfo
deriving instance Generic Name
deriving instance Binary Name
deriving instance Generic Ident
deriving instance Binary Ident
deriving instance Generic CString
deriving instance Binary CString
deriving instance Generic CStructTag
deriving instance Binary CStructTag
deriving instance Generic CFloat
deriving instance Binary CFloat
deriving instance Generic CChar
deriving instance Binary CChar
deriving instance Generic CUnaryOp
deriving instance Binary CUnaryOp
deriving instance Generic CBinaryOp
deriving instance Binary CBinaryOp
deriving instance Generic CInteger
deriving instance Binary CInteger
deriving instance Generic CAssignOp
deriving instance Binary CAssignOp
deriving instance Generic CIntFlag
deriving instance Binary CIntFlag
deriving instance Generic CIntRepr
deriving instance Binary CIntRepr
deriving instance Binary TransState
deriving instance Generic TransState
deriving instance Generic (Annotation a b)
deriving instance (Binary a, Binary b) => Binary (Annotation a b)
deriving instance Generic NodeProperties
deriving instance Binary NodeProperties
deriving instance Generic (PropertyInfo a)
deriving instance Binary a => Binary (PropertyInfo a)
附带说明,这些实例的后半部分可以在类型本身的数据声明中声明(因为它们是在当前文件中声明的)。一个问题是我们仍然没有Binary 的Binary 实例@。我们无法自动派生它,因为它的数据构造函数尚未导出。然而,没有什么能阻止我们手动编写Binary 实例。
instance Binary Position where
put p | isNoPos p = putWord8 0
| isBuiltinPos p = putWord8 1
| isInternalPos p = putWord8 2
| isSourcePos p = putWord8 3 >> put (posOffset p) >> put (posFile p) >> put (posRow p) >> put (posColumn p)
get = do
marker <- getWord8
case marker of
0 -> return nopos
1 -> return builtinPos
2 -> return internalPos
3 -> position <$> get <*> get <*> get <*> get