Add Binary instances for various types used by the profiling code

clash-lib/clash-lib.cabal

@@ -100,6 +100,7 @@ Library
                       ansi-wl-pprint          >= 0.6.8.2  && < 1.0,
                       attoparsec              >= 0.10.4.0 && < 0.14,
                       base                    >= 4.8      && < 5,
+                      binary                  >= 0.8.5    && < 0.11,
                       bytestring              >= 0.10.0.2 && < 0.11,
                       clash-prelude           >= 0.11.1   && < 1.0,
                       concurrent-supply       >= 0.1.7    && < 0.2,
@@ -128,6 +129,7 @@ Library
                       transformers            >= 0.3.0.0  && < 0.6,
                       trifecta                >= 1.7.1.1  && < 2.0,
                       vector                  >= 0.11     && < 1.0,
+                      vector-binary-instances >= 0.2.3.5  && < 0.3,
                       unbound-generics        >= 0.1      && < 0.4,
                       unordered-containers    >= 0.2.3.3  && < 0.3
 

clash-lib/src/Clash/Annotations/TopEntity/Extra.hs

@@ -11,9 +11,20 @@ module Clash.Annotations.TopEntity.Extra where
 import Clash.Annotations.TopEntity (TopEntity, PortName)
 import Language.Haskell.TH.Syntax
   (ModName, Name, NameFlavour, NameSpace, PkgName, OccName)
+import Data.Binary                 (Binary)
 import Data.Hashable               (Hashable)
 import Control.DeepSeq             (NFData)
 
+instance Binary TopEntity
+instance Binary PortName
+
+instance Binary Name
+instance Binary OccName
+instance Binary NameFlavour
+instance Binary ModName
+instance Binary NameSpace
+instance Binary PkgName
+
 instance Hashable TopEntity
 instance Hashable PortName
 

clash-lib/src/Clash/Core/DataCon.hs

@@ -27,6 +27,7 @@ where
 #endif
 
 import Control.DeepSeq                        (NFData(..))
+import Data.Binary                            (Binary)
 import Data.Hashable                          (Hashable)
 import GHC.Generics                           (Generic)
 import Unbound.Generics.LocallyNameless       (Alpha(..),Subst(..))
@@ -54,7 +55,7 @@ data DataCon
                              -- these type variables are not part of the result
                              -- of the DataCon, but only of the arguments.
   , dcArgTys     :: [Type]   -- ^ Argument types
-  } deriving (Generic,NFData,Hashable)
+  } deriving (Generic,NFData,Hashable,Binary)
 
 instance Show DataCon where
   show = show . dcName

clash-lib/src/Clash/Core/Literal.hs

@@ -20,6 +20,8 @@ module Clash.Core.Literal
 where
 
 import Control.DeepSeq                        (NFData (..))
+import Data.Binary                            (Binary)
+import Data.Vector.Binary                     ()
 import Data.Hashable                          (Hashable)
 import Data.Vector.Primitive.Extra            (Vector)
 import Data.Word                              (Word8)
@@ -48,7 +50,7 @@ data Literal
   | CharLiteral     !Char
   | NaturalLiteral  !Integer
   | ByteArrayLiteral !(Vector Word8)
-  deriving (Eq,Ord,Show,Generic,NFData,Hashable)
+  deriving (Eq,Ord,Show,Generic,NFData,Hashable,Binary)
 
 instance Alpha Literal where
   fvAny' _ _ l = pure l

clash-lib/src/Clash/Core/Name.hs

@@ -19,9 +19,11 @@ module Clash.Core.Name
 where
 
 import           Control.DeepSeq                        (NFData)
+import           Data.Binary                            (Binary)
 import           Data.Function                          (on)
 import           Data.Hashable                          (Hashable)
 import           Data.Typeable                          (Typeable)
+import           GHC.BasicTypes.Extra                   ()
 import           GHC.Generics                           (Generic)
 import           GHC.SrcLoc.Extra                       ()
 import           Unbound.Generics.LocallyNameless       hiding
@@ -38,7 +40,7 @@ data Name a
   , nameOcc  :: OccName a
   , nameLoc  :: !SrcSpan
   }
-  deriving (Show,Generic,NFData,Hashable)
+  deriving (Show,Generic,NFData,Hashable,Binary)
 
 instance Eq (Name a) where
   (==) = (==) `on` nameOcc
@@ -52,7 +54,7 @@ data NameSort
   = User
   | System
   | Internal
-  deriving (Eq,Ord,Show,Generic,NFData,Hashable)
+  deriving (Eq,Ord,Show,Generic,NFData,Hashable,Binary)
 
 instance Typeable a => Alpha (Name a) where
   aeq'      ctx (Name _ nm1 _) (Name _ nm2 _) = aeq'      ctx nm1 nm2

clash-lib/src/Clash/Core/Term.hs

@@ -25,6 +25,7 @@ where
 
 -- External Modules
 import Control.DeepSeq
+import Data.Binary                             (Binary)
 import Data.Hashable                           (Hashable)
 import Data.Text                               (Text)
 import GHC.Generics
@@ -52,7 +53,7 @@ data Term
   | Case    !Term !Type [Alt]               -- ^ Case-expression: subject, type of
                                             -- alternatives, list of alternatives
   | Cast    !Term !Type !Type               -- ^ Cast a term from one type to another
-  deriving (Show,Generic,NFData,Hashable)
+  deriving (Show,Generic,NFData,Hashable,Binary)
 
 -- | Term reference
 type TmName     = Name Term
@@ -69,7 +70,7 @@ data Pat
   -- ^ Literal pattern
   | DefaultPat
   -- ^ Default pattern
-  deriving (Eq,Show,Generic,NFData,Alpha,Hashable)
+  deriving (Eq,Show,Generic,NFData,Alpha,Hashable,Binary)
 
 type Alt = Bind Pat Term
 

clash-lib/src/Clash/Core/TyCon.hs

@@ -30,6 +30,7 @@ where
 
 -- External Import
 import Control.DeepSeq
+import Data.Binary                            (Binary)
 import Data.HashMap.Lazy                      (HashMap)
 import GHC.Generics
 import Unbound.Generics.LocallyNameless       (Alpha(..))
@@ -72,7 +73,7 @@ data TyCon
   | SuperKindTyCon
   { tyConName :: !TyConName     -- ^ Name of the TyCon
   }
-  deriving (Generic,NFData)
+  deriving (Generic,NFData,Binary)
 
 instance Show TyCon where
   show (AlgTyCon       {tyConName = n}) = "AlgTyCon: " ++ show n
@@ -104,7 +105,7 @@ data AlgTyConRhs
                                  -- The TyName's are the type-variables from
                                  -- the corresponding TyCon.
   }
-  deriving (Show,Generic,NFData,Alpha)
+  deriving (Show,Generic,NFData,Alpha,Binary)
 
 instance Alpha TyCon where
   aeq' c tc1 tc2      = aeq' c (tyConName tc1) (tyConName tc2)

clash-lib/src/Clash/Core/Type.hs

@@ -59,6 +59,7 @@ where
 
 -- External import
 import           Control.DeepSeq                         as DS
+import           Data.Binary                             (Binary)
 import           Data.Hashable                           (Hashable)
 import           Data.HashMap.Strict                     (HashMap)
 import qualified Data.HashMap.Strict                     as HashMap
@@ -104,7 +105,7 @@ data Type
   | AppTy    !Type !Type        -- ^ Type Application
   | LitTy    !LitTy             -- ^ Type literal
   | AnnType  [Attr'] !Type      -- ^ Annotated type, see Clash.Annotations.SynthesisAttributes
-  deriving (Show,Generic,NFData,Hashable)
+  deriving (Show,Generic,NFData,Hashable,Binary)
 
 -- | An easier view on types
 data TypeView
@@ -117,13 +118,13 @@ data TypeView
 data ConstTy
   = TyCon !TyConName -- ^ TyCon type
   | Arrow            -- ^ Function type
-  deriving (Show,Generic,NFData,Alpha,Hashable)
+  deriving (Show,Generic,NFData,Alpha,Hashable,Binary)
 
 -- | Literal Types
 data LitTy
   = NumTy !Integer
   | SymTy !String
-  deriving (Show,Generic,NFData,Alpha,Hashable)
+  deriving (Show,Generic,NFData,Alpha,Hashable,Binary)
 
 -- | The level above types
 type Kind       = Type

clash-lib/src/Clash/Core/Type.hs-boot

@@ -12,6 +12,7 @@
 module Clash.Core.Type where
 
 import Control.DeepSeq                  (NFData)
+import Data.Binary                      (Binary)
 import Data.Hashable                    (Hashable)
 import GHC.Generics                     (Generic)
 import Unbound.Generics.LocallyNameless (Alpha,Subst)
@@ -36,5 +37,6 @@ instance Subst    Type Type
 instance Subst    Term Type
 instance NFData   Type
 instance Hashable Type
+instance Binary   Type
 
 mkTyConTy :: TyConName -> Type

clash-lib/src/Clash/Core/Var.hs

@@ -23,6 +23,7 @@ where
 
 
 import Control.DeepSeq                  (NFData (..))
+import Data.Binary                      (Binary)
 import Data.Hashable                    (Hashable)
 import Data.Typeable                    (Typeable)
 import GHC.Generics                     (Generic)
@@ -41,7 +42,7 @@ data Attr'
   | IntegerAttr' String Integer
   | StringAttr' String String
   | Attr' String
-  deriving (Eq, Show, NFData, Generic, Hashable, Typeable, Alpha, Ord)
+  deriving (Eq, Show, NFData, Generic, Hashable, Typeable, Alpha, Ord, Binary)
 
 instance Subst Type Attr'
 instance Subst Term Attr'
@@ -64,7 +65,7 @@ data Var a
   { varName :: Name a
   , varType :: Embed Type
   }
-  deriving (Eq,Show,Generic,NFData,Hashable)
+  deriving (Eq,Show,Generic,NFData,Hashable,Binary)
 
 -- | Term variable
 type Id    = Var Term

clash-lib/src/Clash/Netlist/BlackBox/Types.hs

@@ -22,6 +22,7 @@ module Clash.Netlist.BlackBox.Types
  ) where
 
 import                Control.DeepSeq            (NFData)
+import                Data.Binary                (Binary)
 import                Data.Text.Lazy             (Text)
 import qualified      Data.Text                  as S
 import                GHC.Generics               (Generic)
@@ -34,7 +35,7 @@ import {-# SOURCE #-} Clash.Netlist.Types        (BlackBox, Identifier)
 data TemplateKind
   = TDecl
   | TExpr
-  deriving (Show, Eq, Generic, NFData)
+  deriving (Show, Eq, Generic, NFData, Binary)
 
 -- | See @Clash.Primitives.Types.BlackBox@ for documentation on this record's
 -- fields. (They are intentionally renamed to prevent name clashes.)
@@ -119,7 +120,7 @@ data Element = C   !Text         -- ^ Constant
              | Repeat [Element] [Element] -- ^ Repeat <hole> n times
              | DevNull [Element]          -- ^ Evaluate <hole> but swallow output
              | SigD [Element] !(Maybe Int)
-  deriving (Show, Generic, NFData)
+  deriving (Show, Generic, NFData, Binary)
 
 -- | Component instantiation hole. First argument indicates which function argument
 -- to instantiate. Second argument corresponds to output and input assignments,
@@ -129,7 +130,7 @@ data Element = C   !Text         -- ^ Constant
 -- The LHS of the tuple is the name of the signal, while the RHS of the tuple
 -- is the type of the signal
 data Decl = Decl !Int [(BlackBoxTemplate,BlackBoxTemplate)]
-  deriving (Show, Generic, NFData)
+  deriving (Show, Generic, NFData, Binary)
 
 data HdlSyn = Vivado | Quartus | Other
-  deriving (Eq, Show, Read, Generic, NFData)
+  deriving (Eq, Show, Read, Generic, NFData, Binary)

clash-lib/src/Clash/Netlist/Types.hs

@@ -31,6 +31,7 @@ import Control.DeepSeq
 import Control.Monad.State                  (State)
 import Control.Monad.State.Strict           (MonadIO, MonadState, StateT)
 import Data.Bits                            (testBit)
+import Data.Binary                          (Binary(..))
 import Data.Hashable
 import Data.HashMap.Lazy                    (HashMap)
 import Data.IntMap.Lazy                     (IntMap, empty)
@@ -331,7 +332,7 @@ data BlackBoxContext
 data BlackBox
   = BBTemplate BlackBoxTemplate
   | BBFunction TemplateFunction
-  deriving (Generic,NFData)
+  deriving (Generic, NFData, Binary)
 
 data TemplateFunction where
   TemplateFunction
@@ -347,6 +348,12 @@ instance Show BlackBox where
 instance NFData TemplateFunction where
   rnf (TemplateFunction is f _) = rnf is `seq` f `seq` ()
 
+-- | __NB__: serialisation doesn't preserve the embedded function
+instance Binary TemplateFunction where
+  put (TemplateFunction is _ _ ) = put is
+  get = (\is -> TemplateFunction is err err) <$> get
+    where err = const $ error "TemplateFunction functions can't be preserved by serialisation"
+
 emptyBBContext :: BlackBoxContext
 emptyBBContext
   = Context

clash-lib/src/Clash/Primitives/Types.hs

@@ -39,6 +39,7 @@ import           Control.Applicative          ((<|>))
 import           Control.DeepSeq              (NFData)
 import           Data.Aeson
   (FromJSON (..), Value (..), (.:), (.:?), (.!=))
+import           Data.Binary                  (Binary)
 import           Data.Char                    (isUpper, isLower, isAlphaNum)
 import           Data.Either                  (lefts)
 import           Data.HashMap.Lazy            (HashMap)
@@ -69,7 +70,7 @@ type PrimMap a = HashMap S.Text a
 -- guaranteed to have at least one module name which is not /Main/.
 data BlackBoxFunctionName =
   BlackBoxFunctionName [String] String
-    deriving (Eq, Generic, NFData)
+    deriving (Eq, Generic, NFData, Binary)
 
 instance Show BlackBoxFunctionName where
   show (BlackBoxFunctionName mods funcName) =
@@ -164,7 +165,7 @@ data Primitive a b c
   , primType :: !Text
     -- ^ Additional information
   }
-  deriving (Show, Generic, NFData)
+  deriving (Show, Generic, NFData, Binary)
 
 instance FromJSON UnresolvedPrimitive where
   parseJSON (Object v) =

clash-lib/src/GHC/BasicTypes/Extra.hs

@@ -13,7 +13,9 @@ module GHC.BasicTypes.Extra where
 
 import BasicTypes
 import Control.DeepSeq
+import Data.Binary
 import GHC.Generics
 
 deriving instance Generic InlineSpec
 instance NFData InlineSpec
+instance Binary InlineSpec

clash-lib/src/GHC/SrcLoc/Extra.hs

@@ -13,12 +13,16 @@
 
 module GHC.SrcLoc.Extra where
 
+import Data.Binary
 import Data.Hashable                        (Hashable (..))
 import GHC.Generics
 import SrcLoc
-  (SrcSpan (..), RealSrcSpan, srcSpanFile, srcSpanStartLine, srcSpanEndLine,
-   srcSpanStartCol, srcSpanEndCol)
-import FastString                           (FastString (..))
+  (SrcSpan (..), RealSrcLoc, RealSrcSpan,
+   mkRealSrcLoc, mkRealSrcSpan,
+   realSrcSpanStart, realSrcSpanEnd,
+   srcLocFile, srcLocLine, srcLocCol,
+   srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol)
+import FastString                           (FastString (..), bytesFS, mkFastStringByteList)
 import Unbound.Generics.LocallyNameless     (Alpha (..))
 import Unbound.Generics.LocallyNameless.TH
 
@@ -35,3 +39,15 @@ instance Hashable RealSrcSpan where
 instance Hashable FastString where
   hashWithSalt salt fs = hashWithSalt salt (uniq fs)
 
+instance Binary SrcSpan
+instance Binary RealSrcSpan where
+  put r = put (realSrcSpanStart r, realSrcSpanEnd r)
+  get = uncurry mkRealSrcSpan <$> get
+
+instance Binary RealSrcLoc where
+  put r = put (srcLocFile r, srcLocLine r, srcLocCol r)
+  get = (\(file,line,col) -> mkRealSrcLoc file line col) <$> get
+
+instance Binary FastString where
+  put str = put $ bytesFS str
+  get = mkFastStringByteList <$> get

clash-lib/src/Unbound/Generics/LocallyNameless/Extra.hs

@@ -20,6 +20,7 @@ module Unbound.Generics.LocallyNameless.Extra where
 #if !MIN_VERSION_unbound_generics(0,2,0)
 import Control.DeepSeq
 #endif
+import Data.Binary
 import Data.Vector.Primitive
 import Data.Hashable                           (Hashable(..),hash)
 #if MIN_VERSION_unbound_generics(0,3,0)
@@ -113,3 +114,9 @@ instance Alpha Text where
 instance Subst b Text where
   subst  _ _ = id
   substs _   = id
+
+instance (Binary a, Binary b) => Binary (Bind a b)
+instance Binary a => Binary (Embed a)
+instance Binary (Name a)
+instance (Binary a, Binary b) => Binary (Rebind a b)
+instance Binary a => Binary (Rec a)