    {-|
    Copyright  :  (C) 2018, Google Inc.
                      2019, Myrtle Software Ltd
                      2022-2024, QBayLogic B.V.
    License    :  BSD2 (see the file LICENSE)
    Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

    Utilities for tracing signals and dumping them in various ways. Example usage:

    @
    import Clash.Prelude hiding (writeFile)
    import Data.Text.IO  (writeFile)

    -- | Count and wrap around
    subCounter :: SystemClockResetEnable => Signal System (Index 3)
    subCounter = traceSignal1 "sub" counter
      where
        counter =
          register 0 (fmap succ' counter)

        succ' c
          | c == maxBound = 0
          | otherwise     = c + 1

    -- | Count, but only when my subcounter is wrapping around
    mainCounter :: SystemClockResetEnable => Signal System (Signed 64)
    mainCounter = traceSignal1 "main" counter
      where
        counter =
          register 0 (fmap succ' $ bundle (subCounter,counter))

        succ' (sc, c)
          | sc == maxBound = c + 1
          | otherwise      = c

    -- | Collect traces, and dump them to a VCD file.
    main :: IO ()
    main = do
      let cntrOut = exposeClockResetEnable mainCounter systemClockGen systemResetGen enableGen
      vcd <- dumpVCD (0, 100) cntrOut ["main", "sub"]
      case vcd of
        Left msg ->
          error msg
        Right contents ->
          writeFile "mainCounter.vcd" contents
    @
    -}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
    {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise       #-}

    module Clash.Signal.Trace
      (
      -- * Tracing functions
      -- ** Simple
        traceSignal1
      , traceVecSignal1
      -- ** Tracing in a multi-clock environment
      , traceSignal
      , traceVecSignal

      -- * VCD dump functions
      , dumpVCD

      -- * Replay functions
      , dumpReplayable
      , replay

      -- * Internal
      -- ** Types
      , Period
      , Changed
      , Value
      , Width
      , TraceMap
      , TypeRepBS
      -- ** Functions
      , traceSignal#
      , traceVecSignal#
      , dumpVCD#
      , dumpVCD##
      , waitForTraces#
      , traceMap#
      ) where

    -- Clash:
    import           Clash.Annotations.Primitive (hasBlackBox)
    import           Clash.Signal.Internal (fromList)
    import           Clash.Signal
      (KnownDomain(..), SDomainConfiguration(..), Signal, bundle, unbundle)
    import           Clash.Sized.Vector    (Vec, iterateI)
    import qualified Clash.Sized.Vector    as Vector
    import           Clash.Class.BitPack   (BitPack, BitSize, pack, unpack)
    import           Clash.Promoted.Nat    (snatToNum, SNat(..))
    import           Clash.Signal.Internal (Signal ((:-)), sample)
    import           Clash.XException      (deepseqX, NFDataX)
    import           Clash.Sized.Internal.BitVector
      (BitVector(BV))

    -- Haskell / GHC:
    import           Control.Monad         (foldM)
    import           Data.Bits             (testBit)
    import           Data.Binary           (encode, decodeOrFail)
    import           Data.ByteString.Lazy  (ByteString)
    import qualified Data.ByteString.Lazy  as ByteStringLazy
    import           Data.Char             (ord, chr)
    import           Data.IORef
      (IORef, atomicModifyIORef', atomicWriteIORef, newIORef, readIORef)
    #if !MIN_VERSION_base(4,20,0)
    import           Data.List             (foldl')
    #endif
    import           Data.List             (foldl1', unzip4, transpose, uncons)
    import qualified Data.Map.Strict       as Map
    import           Data.Maybe            (fromMaybe, catMaybes)
    import qualified Data.Text             as Text
    import           Data.Time.Clock       (UTCTime, getCurrentTime)
    import           Data.Time.Format      (formatTime, defaultTimeLocale)
    import           GHC.Natural           (Natural)
    import           GHC.Stack             (HasCallStack)
    import           GHC.TypeLits          (KnownNat, type (+))
    import           System.IO.Unsafe      (unsafePerformIO)
    import           Type.Reflection       (Typeable, TypeRep, typeRep)

    #ifdef CABAL
    import qualified Data.Version
    import qualified Paths_clash_prelude
    #endif

    type Period   = Int
    type Changed  = Bool
    type Value    = (Natural, Natural) -- (Mask, Value)
    type Width    = Int

    -- | Serialized TypeRep we need to store for dumpReplayable / replay
    type TypeRepBS = ByteString

    type TraceMap  = Map.Map String (TypeRepBS, Period, Width, [Value])

    -- | Map of traces used by the non-internal trace and dumpvcd functions.
    traceMap# :: IORef TraceMap
    traceMap# :: IORef TraceMap
    traceMap# = IO (IORef TraceMap) -> IORef TraceMap
    forall a. IO a -> a
    unsafePerformIO (TraceMap -> IO (IORef TraceMap)
    forall a. a -> IO (IORef a)
    newIORef TraceMap
    forall k a. Map k a
    Map.empty)
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceMap# #-}

    mkTrace
      :: HasCallStack
      => BitPack a
      => NFDataX a
      => Signal dom a
      -> [Value]
    mkTrace :: forall a (dom :: Domain).
    (HasCallStack, BitPack a, NFDataX a) =>
    Signal dom a -> [Value]
    mkTrace Signal dom a
    signal = Signal dom Value -> [Value]
    forall (f :: Type -> Type) a. (Foldable f, NFDataX a) => f a -> [a]
    sample (BitVector (BitSize a) -> Value
    forall {n :: Natural}. BitVector n -> Value
    unsafeToTup (BitVector (BitSize a) -> Value)
    -> (a -> BitVector (BitSize a)) -> a -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> BitVector (BitSize a)
    forall a. BitPack a => a -> BitVector (BitSize a)
    pack (a -> Value) -> Signal dom a -> Signal dom Value
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Signal dom a
    signal)
     where
      unsafeToTup :: BitVector n -> Value
    unsafeToTup (BV Natural
    mask Natural
    value) = (Natural
    mask, Natural
    value)

    -- | Trace a single signal. Will emit an error if a signal with the same name
    -- was previously registered.
    traceSignal#
      :: forall dom a
       . ( BitPack a
         , NFDataX a
         , Typeable a )
      => IORef TraceMap
      -- ^ Map to store the trace
      -> Int
      -- ^ The associated clock period for the trace
      -> String
      -- ^ Name of signal in the VCD output
      -> Signal dom a
      -- ^ Signal to trace
      -> IO (Signal dom a)
    traceSignal# :: forall (dom :: Domain) a.
    (BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    traceSignal# IORef TraceMap
    traceMap Int
    period [Char]
    traceName Signal dom a
    signal =
      IORef TraceMap
    -> (TraceMap -> (TraceMap, Signal dom a)) -> IO (Signal dom a)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef TraceMap
    traceMap ((TraceMap -> (TraceMap, Signal dom a)) -> IO (Signal dom a))
    -> (TraceMap -> (TraceMap, Signal dom a)) -> IO (Signal dom a)
    forall a b. (a -> b) -> a -> b
    $ \TraceMap
    m ->
        if [Char] -> TraceMap -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member [Char]
    traceName TraceMap
    m then
          [Char] -> (TraceMap, Signal dom a)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (TraceMap, Signal dom a))
    -> [Char] -> (TraceMap, Signal dom a)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Already tracing a signal with the name: '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    traceName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "'."
        else
          ( [Char] -> (TypeRepBS, Int, Int, [Value]) -> TraceMap -> TraceMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert
              [Char]
    traceName
              ( TypeRep a -> TypeRepBS
    forall a. Binary a => a -> TypeRepBS
    encode (forall a. Typeable a => TypeRep a
    forall {k} (a :: k). Typeable a => TypeRep a
    typeRep @a)
              , Int
    period
              , Int
    width
              , Signal dom a -> [Value]
    forall a (dom :: Domain).
    (HasCallStack, BitPack a, NFDataX a) =>
    Signal dom a -> [Value]
    mkTrace Signal dom a
    signal)
              TraceMap
    m
          , Signal dom a
    signal)
     where
      width :: Int
    width = SNat (BitSize a) -> Int
    forall a (n :: Natural). Num a => SNat n -> a
    snatToNum (forall (n :: Natural). KnownNat n => SNat n
    SNat @(BitSize a))
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceSignal# #-}

    -- | Trace a single vector signal: each element in the vector will show up as
    -- a different trace. If the trace name already exists, this function will emit
    -- an error.
    traceVecSignal#
      :: forall dom n a
       . ( KnownNat n
         , BitPack a
         , NFDataX a
         , Typeable a )
      => IORef TraceMap
      -- ^ Map to store the traces
      -> Int
      -- ^ Associated clock period for the trace
      -> String
      -- ^ Name of signal in the VCD output. Will be appended by _0, _1, ..., _n.
      -> Signal dom (Vec (n+1) a)
      -- ^ Signal to trace
      -> IO (Signal dom (Vec (n+1) a))
    traceVecSignal# :: forall (dom :: Domain) (n :: Natural) a.
    (KnownNat n, BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int
    -> [Char]
    -> Signal dom (Vec (n + 1) a)
    -> IO (Signal dom (Vec (n + 1) a))
    traceVecSignal# IORef TraceMap
    traceMap Int
    period [Char]
    vecTraceName (Signal dom (Vec (n + 1) a) -> Unbundled dom (Vec (n + 1) a)
    forall a (dom :: Domain).
    Bundle a =>
    Signal dom a -> Unbundled dom a
    forall (dom :: Domain).
    Signal dom (Vec (n + 1) a) -> Unbundled dom (Vec (n + 1) a)
    unbundle -> Unbundled dom (Vec (n + 1) a)
    vecSignal) =
      (Vec (n + 1) (Signal dom a) -> Signal dom (Vec (n + 1) a))
    -> IO (Vec (n + 1) (Signal dom a))
    -> IO (Signal dom (Vec (n + 1) a))
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap Vec (n + 1) (Signal dom a) -> Signal dom (Vec (n + 1) a)
    Unbundled dom (Vec (n + 1) a) -> Signal dom (Vec (n + 1) a)
    forall a (dom :: Domain).
    Bundle a =>
    Unbundled dom a -> Signal dom a
    forall (dom :: Domain).
    Unbundled dom (Vec (n + 1) a) -> Signal dom (Vec (n + 1) a)
    bundle (IO (Vec (n + 1) (Signal dom a))
     -> IO (Signal dom (Vec (n + 1) a)))
    -> (Vec (n + 1) (IO (Signal dom a))
        -> IO (Vec (n + 1) (Signal dom a)))
    -> Vec (n + 1) (IO (Signal dom a))
    -> IO (Signal dom (Vec (n + 1) a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vec (n + 1) (IO (Signal dom a)) -> IO (Vec (n + 1) (Signal dom a))
    forall (t :: Type -> Type) (f :: Type -> Type) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: Type -> Type) a.
    Applicative f =>
    Vec (n + 1) (f a) -> f (Vec (n + 1) a)
    sequenceA (Vec (n + 1) (IO (Signal dom a))
     -> IO (Signal dom (Vec (n + 1) a)))
    -> Vec (n + 1) (IO (Signal dom a))
    -> IO (Signal dom (Vec (n + 1) a))
    forall a b. (a -> b) -> a -> b
    $
        (Int -> Signal dom a -> IO (Signal dom a))
    -> Vec (n + 1) Int
    -> Vec (n + 1) (Signal dom a)
    -> Vec (n + 1) (IO (Signal dom a))
    forall a b c (n :: Natural).
    (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
    Vector.zipWith Int -> Signal dom a -> IO (Signal dom a)
    trace' ((Int -> Int) -> Int -> Vec (n + 1) Int
    forall (n :: Natural) a. KnownNat n => (a -> a) -> a -> Vec n a
    iterateI Int -> Int
    forall a. Enum a => a -> a
    succ (Int
    0 :: Int)) Vec (n + 1) (Signal dom a)
    Unbundled dom (Vec (n + 1) a)
    vecSignal
     where
      trace' :: Int -> Signal dom a -> IO (Signal dom a)
    trace' Int
    i Signal dom a
    s = IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    forall (dom :: Domain) a.
    (BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    traceSignal# IORef TraceMap
    traceMap Int
    period (Int -> [Char]
    name' Int
    i) Signal dom a
    s
      name' :: Int -> [Char]
    name' Int
    i    = [Char]
    vecTraceName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "_" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceVecSignal# #-}

    -- | Trace a single signal. Will emit an error if a signal with the same name
    -- was previously registered.
    --
    -- __NB__: Works correctly when creating VCD files from traced signal in
    -- multi-clock circuits. However 'traceSignal1' might be more convenient to
    -- use when the domain of your circuit is polymorphic.
    traceSignal
      :: forall dom  a
       . ( KnownDomain dom
         , BitPack a
         , NFDataX a
         , Typeable a )
      => String
      -- ^ Name of signal in the VCD output
      -> Signal dom a
      -- ^ Signal to trace
      -> Signal dom a
    traceSignal :: forall (dom :: Domain) a.
    (KnownDomain dom, BitPack a, NFDataX a, Typeable a) =>
    [Char] -> Signal dom a -> Signal dom a
    traceSignal [Char]
    traceName Signal dom a
    signal =
      case forall (dom :: Domain).
    KnownDomain dom =>
    SDomainConfiguration dom (KnownConf dom)
    knownDomain @dom of
        SDomainConfiguration{SNat period
    sPeriod :: SNat period
    sPeriod :: forall (dom :: Domain) (period :: Natural) (edge :: ActiveEdge)
           (reset :: ResetKind) (init :: InitBehavior)
           (polarity :: ResetPolarity).
    SDomainConfiguration
      dom ('DomainConfiguration dom period edge reset init polarity)
    -> SNat period
    sPeriod} ->
          IO (Signal dom a) -> Signal dom a
    forall a. IO a -> a
    unsafePerformIO (IO (Signal dom a) -> Signal dom a)
    -> IO (Signal dom a) -> Signal dom a
    forall a b. (a -> b) -> a -> b
    $
            IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    forall (dom :: Domain) a.
    (BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    traceSignal# IORef TraceMap
    traceMap# (SNat period -> Int
    forall a (n :: Natural). Num a => SNat n -> a
    snatToNum SNat period
    sPeriod) [Char]
    traceName Signal dom a
    signal
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceSignal #-}
    {-# ANN traceSignal hasBlackBox #-}

    -- | Trace a single signal. Will emit an error if a signal with the same name
    -- was previously registered.
    --
    -- __NB__: Associates the traced signal with a clock period of /1/, which
    -- results in incorrect VCD files when working with circuits that have
    -- multiple clocks. Use 'traceSignal' when working with circuits that have
    -- multiple clocks.
    traceSignal1
      :: ( BitPack a
         , NFDataX a
         , Typeable a )
      => String
      -- ^ Name of signal in the VCD output
      -> Signal dom a
      -- ^ Signal to trace
      -> Signal dom a
    traceSignal1 :: forall a (dom :: Domain).
    (BitPack a, NFDataX a, Typeable a) =>
    [Char] -> Signal dom a -> Signal dom a
    traceSignal1 [Char]
    traceName Signal dom a
    signal =
      IO (Signal dom a) -> Signal dom a
    forall a. IO a -> a
    unsafePerformIO (IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    forall (dom :: Domain) a.
    (BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int -> [Char] -> Signal dom a -> IO (Signal dom a)
    traceSignal# IORef TraceMap
    traceMap# Int
    1 [Char]
    traceName Signal dom a
    signal)
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceSignal1 #-}
    {-# ANN traceSignal1 hasBlackBox #-}

    -- | Trace a single vector signal: each element in the vector will show up as
    -- a different trace. If the trace name already exists, this function will emit
    -- an error.
    --
    -- __NB__: Works correctly when creating VCD files from traced signal in
    -- multi-clock circuits. However 'traceSignal1' might be more convenient to
    -- use when the domain of your circuit is polymorphic.
    traceVecSignal
      :: forall dom a  n
       . ( KnownDomain dom
         , KnownNat n
         , BitPack a
         , NFDataX a
         , Typeable a )
      => String
      -- ^ Name of signal in debugging output. Will be appended by _0, _1, ..., _n.
      -> Signal dom (Vec (n+1) a)
      -- ^ Signal to trace
      -> Signal dom (Vec (n+1) a)
    traceVecSignal :: forall (dom :: Domain) a (n :: Natural).
    (KnownDomain dom, KnownNat n, BitPack a, NFDataX a, Typeable a) =>
    [Char] -> Signal dom (Vec (n + 1) a) -> Signal dom (Vec (n + 1) a)
    traceVecSignal [Char]
    traceName Signal dom (Vec (n + 1) a)
    signal =
      case forall (dom :: Domain).
    KnownDomain dom =>
    SDomainConfiguration dom (KnownConf dom)
    knownDomain @dom of
        SDomainConfiguration{SNat period
    sPeriod :: forall (dom :: Domain) (period :: Natural) (edge :: ActiveEdge)
           (reset :: ResetKind) (init :: InitBehavior)
           (polarity :: ResetPolarity).
    SDomainConfiguration
      dom ('DomainConfiguration dom period edge reset init polarity)
    -> SNat period
    sPeriod :: SNat period
    sPeriod} ->
          IO (Signal dom (Vec (n + 1) a)) -> Signal dom (Vec (n + 1) a)
    forall a. IO a -> a
    unsafePerformIO (IO (Signal dom (Vec (n + 1) a)) -> Signal dom (Vec (n + 1) a))
    -> IO (Signal dom (Vec (n + 1) a)) -> Signal dom (Vec (n + 1) a)
    forall a b. (a -> b) -> a -> b
    $
            IORef TraceMap
    -> Int
    -> [Char]
    -> Signal dom (Vec (n + 1) a)
    -> IO (Signal dom (Vec (n + 1) a))
    forall (dom :: Domain) (n :: Natural) a.
    (KnownNat n, BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int
    -> [Char]
    -> Signal dom (Vec (n + 1) a)
    -> IO (Signal dom (Vec (n + 1) a))
    traceVecSignal# IORef TraceMap
    traceMap# (SNat period -> Int
    forall a (n :: Natural). Num a => SNat n -> a
    snatToNum SNat period
    sPeriod) [Char]
    traceName Signal dom (Vec (n + 1) a)
    signal
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceVecSignal #-}
    {-# ANN traceVecSignal hasBlackBox #-}

    -- | Trace a single vector signal: each element in the vector will show up as
    -- a different trace. If the trace name already exists, this function will emit
    -- an error.
    --
    -- __NB__: Associates the traced signal with a clock period of /1/, which
    -- results in incorrect VCD files when working with circuits that have
    -- multiple clocks. Use 'traceSignal' when working with circuits that have
    -- multiple clocks.
    traceVecSignal1
      :: ( KnownNat n
         , BitPack a
         , NFDataX a
         , Typeable a )
      => String
      -- ^ Name of signal in debugging output. Will be appended by _0, _1, ..., _n.
      -> Signal dom (Vec (n+1) a)
      -- ^ Signal to trace
      -> Signal dom (Vec (n+1) a)
    traceVecSignal1 :: forall (n :: Natural) a (dom :: Domain).
    (KnownNat n, BitPack a, NFDataX a, Typeable a) =>
    [Char] -> Signal dom (Vec (n + 1) a) -> Signal dom (Vec (n + 1) a)
    traceVecSignal1 [Char]
    traceName Signal dom (Vec (n + 1) a)
    signal =
      IO (Signal dom (Vec (n + 1) a)) -> Signal dom (Vec (n + 1) a)
    forall a. IO a -> a
    unsafePerformIO (IO (Signal dom (Vec (n + 1) a)) -> Signal dom (Vec (n + 1) a))
    -> IO (Signal dom (Vec (n + 1) a)) -> Signal dom (Vec (n + 1) a)
    forall a b. (a -> b) -> a -> b
    $ IORef TraceMap
    -> Int
    -> [Char]
    -> Signal dom (Vec (n + 1) a)
    -> IO (Signal dom (Vec (n + 1) a))
    forall (dom :: Domain) (n :: Natural) a.
    (KnownNat n, BitPack a, NFDataX a, Typeable a) =>
    IORef TraceMap
    -> Int
    -> [Char]
    -> Signal dom (Vec (n + 1) a)
    -> IO (Signal dom (Vec (n + 1) a))
    traceVecSignal# IORef TraceMap
    traceMap# Int
    1 [Char]
    traceName Signal dom (Vec (n + 1) a)
    signal
    -- See: https://github.com/clash-lang/clash-compiler/pull/2511
    {-# CLASH_OPAQUE traceVecSignal1 #-}
    {-# ANN traceVecSignal1 hasBlackBox #-}

    iso8601Format :: UTCTime -> String
    iso8601Format :: UTCTime -> [Char]
    iso8601Format = TimeLocale -> [Char] -> UTCTime -> [Char]
    forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
    formatTime TimeLocale
    defaultTimeLocale [Char]
    "%Y-%m-%dT%H:%M:%S"

    toPeriodMap :: TraceMap -> Map.Map Period [(String, Width, [Value])]
    toPeriodMap :: TraceMap -> Map Int [([Char], Int, [Value])]
    toPeriodMap TraceMap
    m = (Map Int [([Char], Int, [Value])]
     -> ([Char], (TypeRepBS, Int, Int, [Value]))
     -> Map Int [([Char], Int, [Value])])
    -> Map Int [([Char], Int, [Value])]
    -> [([Char], (TypeRepBS, Int, Int, [Value]))]
    -> Map Int [([Char], Int, [Value])]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Map Int [([Char], Int, [Value])]
    -> ([Char], (TypeRepBS, Int, Int, [Value]))
    -> Map Int [([Char], Int, [Value])]
    forall {k} {a} {b} {c} {a}.
    Ord k =>
    Map k [(a, b, c)] -> (a, (a, k, b, c)) -> Map k [(a, b, c)]
    go Map Int [([Char], Int, [Value])]
    forall k a. Map k a
    Map.empty (TraceMap -> [([Char], (TypeRepBS, Int, Int, [Value]))]
    forall k a. Map k a -> [(k, a)]
    Map.assocs TraceMap
    m)
      where
        go :: Map k [(a, b, c)] -> (a, (a, k, b, c)) -> Map k [(a, b, c)]
    go Map k [(a, b, c)]
    periodMap (a
    traceName, (a
    _rep, k
    period, b
    width, c
    values)) =
          (Maybe [(a, b, c)] -> Maybe [(a, b, c)])
    -> k -> Map k [(a, b, c)] -> Map k [(a, b, c)]
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter ([(a, b, c)] -> Maybe [(a, b, c)]
    forall a. a -> Maybe a
    Just ([(a, b, c)] -> Maybe [(a, b, c)])
    -> (Maybe [(a, b, c)] -> [(a, b, c)])
    -> Maybe [(a, b, c)]
    -> Maybe [(a, b, c)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe [(a, b, c)] -> [(a, b, c)]
    go') k
    period Map k [(a, b, c)]
    periodMap
            where
              go' :: Maybe [(a, b, c)] -> [(a, b, c)]
    go' = ((a
    traceName, b
    width, c
    values)(a, b, c) -> [(a, b, c)] -> [(a, b, c)]
    forall a. a -> [a] -> [a]
    :) ([(a, b, c)] -> [(a, b, c)])
    -> (Maybe [(a, b, c)] -> [(a, b, c)])
    -> Maybe [(a, b, c)]
    -> [(a, b, c)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(a, b, c)] -> Maybe [(a, b, c)] -> [(a, b, c)]
    forall a. a -> Maybe a -> a
    fromMaybe [])

    flattenMap :: Map.Map a [b] -> [(a, b)]
    flattenMap :: forall a b. Map a [b] -> [(a, b)]
    flattenMap Map a [b]
    m = [[(a, b)]] -> [(a, b)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[(a
    a, b
    b) | b
    b <- [b]
    bs] | (a
    a, [b]
    bs) <- Map a [b] -> [(a, [b])]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map a [b]
    m]

    printable :: Char -> Bool
    printable :: Char -> Bool
    printable (Char -> Int
    ord -> Int
    c) = Int
    33 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c Bool -> Bool -> Bool
    && Int
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    126

    -- | Same as @dumpVCD@, but supplied with a custom tracemap and a custom timestamp
    dumpVCD##
      :: (Int, Int)
      -- ^ (offset, number of samples)
      -> TraceMap
      -> UTCTime
      -> Either String Text.Text
    dumpVCD## :: (Int, Int) -> TraceMap -> UTCTime -> Either [Char] Text
    dumpVCD## (Int
    offset, Int
    cycles) TraceMap
    traceMap UTCTime
    now
      | Int
    offset Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 =
          [Char] -> Either [Char] Text
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either [Char] Text) -> [Char] -> Either [Char] Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "dumpVCD: offset was " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    offset [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", but cannot be negative."
      | Int
    cycles Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 =
          [Char] -> Either [Char] Text
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either [Char] Text) -> [Char] -> Either [Char] Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "dumpVCD: cycles was " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    cycles [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", but cannot be negative."
      | TraceMap -> Bool
    forall a. Map [Char] a -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null TraceMap
    traceMap =
          [Char] -> Either [Char] Text
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Either [Char] Text) -> [Char] -> Either [Char] Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "dumpVCD: no traces found. Extend the given trace names."
      | TraceMap -> Int
    forall k a. Map k a -> Int
    Map.size TraceMap
    traceMap Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    126 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    33 =
          [Char] -> Either [Char] Text
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] Text) -> [Char] -> Either [Char] Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Tracemap contains more than 93 traces, which is not supported by VCD."
      | ([Char]
    nm:[[Char]]
    _) <- [[Char]]
    offensiveNames =
          [Char] -> Either [Char] Text
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] Text) -> [Char] -> Either [Char] Text
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords [ [Char]
    "Trace '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "' contains"
                         , [Char]
    "non-printable ASCII characters, which is not"
                         , [Char]
    "supported by VCD." ]
      | Bool
    otherwise =
          Text -> Either [Char] Text
    forall a b. b -> Either a b
    Right (Text -> Either [Char] Text) -> Text -> Either [Char] Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    Text.unlines [ [Text] -> Text
    Text.unwords [Text]
    headerDate
                               , [Text] -> Text
    Text.unwords [Text]
    headerVersion
                               , [Text] -> Text
    Text.unwords [Text]
    headerComment
                               , [Char] -> Text
    Text.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords [[Char]]
    headerTimescale
                               , Text
    "$scope module logic $end"
                               , Text -> [Text] -> Text
    Text.intercalate Text
    "\n" [Text]
    headerWires
                               , Text
    "$upscope $end"
                               , Text
    "$enddefinitions $end"
                               , Text
    "#0"
                               , Text
    "$dumpvars"
                               , Text -> [Text] -> Text
    Text.intercalate Text
    "\n" [Text]
    initValues
                               , Text
    "$end"
                               , Text -> [Text] -> Text
    Text.intercalate Text
    "\n" ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Maybe Text] -> [Text]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Text]
    bodyParts
                               ]
     where
      offensiveNames :: [[Char]]
    offensiveNames = ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Char -> Bool) -> [Char] -> Bool
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Bool
    any (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    printable)) [[Char]]
    traceNames

      labels :: [Char]
    labels = (Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    chr [Int
    33..Int
    126]

      timescale :: Int
    timescale = (Int -> Int -> Int) -> [Int] -> Int
    forall a. HasCallStack => (a -> a -> a) -> [a] -> a
    foldl1' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    gcd (Map Int [([Char], Int, [Value])] -> [Int]
    forall k a. Map k a -> [k]
    Map.keys Map Int [([Char], Int, [Value])]
    periodMap)
      periodMap :: Map Int [([Char], Int, [Value])]
    periodMap = TraceMap -> Map Int [([Char], Int, [Value])]
    toPeriodMap TraceMap
    traceMap

      -- Normalize traces until they have the "same" period. That is, assume
      -- we have two traces; trace A with a period of 20 ps and trace B with
      -- a period of 40 ps:
      --
      --   A: [A1, A2, A3, ...]
      --   B: [B1, B2, B3, ...]
      --
      -- After normalization these look like:
      --
      --   A: [A1, A2, A3, A4, A5, A6, ...]
      --   B: [B1, B1, B2, B2, B3, B3, ...]
      --
      -- ..because B is "twice as slow" as A.
      ([Int]
    periods, [[Char]]
    traceNames, [Int]
    widths, [[Value]]
    valuess) =
        [(Int, [Char], Int, [Value])]
    -> ([Int], [[Char]], [Int], [[Value]])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 ([(Int, [Char], Int, [Value])]
     -> ([Int], [[Char]], [Int], [[Value]]))
    -> [(Int, [Char], Int, [Value])]
    -> ([Int], [[Char]], [Int], [[Value]])
    forall a b. (a -> b) -> a -> b
    $ ((Int, ([Char], Int, [Value])) -> (Int, [Char], Int, [Value]))
    -> [(Int, ([Char], Int, [Value]))] -> [(Int, [Char], Int, [Value])]
    forall a b. (a -> b) -> [a] -> [b]
    map
          (\(Int
    a, ([Char]
    b, Int
    c, [Value]
    d)) -> (Int
    a, [Char]
    b, Int
    c, [Value]
    d))
          (Map Int [([Char], Int, [Value])] -> [(Int, ([Char], Int, [Value]))]
    forall a b. Map a [b] -> [(a, b)]
    flattenMap Map Int [([Char], Int, [Value])]
    periodMap)

      periods' :: [Int]
    periods' = (Int -> Int) -> [Int] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    timescale) [Int]
    periods
      valuess' :: [[Value]]
    valuess' = ([Value] -> [Value]) -> [[Value]] -> [[Value]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Value] -> [Value]
    slice ([[Value]] -> [[Value]]) -> [[Value]] -> [[Value]]
    forall a b. (a -> b) -> a -> b
    $ (Int -> [Value] -> [Value]) -> [Int] -> [[Value]] -> [[Value]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> [Value] -> [Value]
    forall {t :: Type -> Type} {b}. Foldable t => Int -> t b -> [b]
    normalize [Int]
    periods' [[Value]]
    valuess
      normalize :: Int -> t b -> [b]
    normalize Int
    period t b
    values = (b -> [b]) -> t b -> [b]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (Int -> b -> [b]
    forall a. Int -> a -> [a]
    replicate Int
    period) t b
    values
      slice :: [Value] -> [Value]
    slice [Value]
    values = Int -> [Value] -> [Value]
    forall a. Int -> [a] -> [a]
    drop Int
    offset ([Value] -> [Value]) -> [Value] -> [Value]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Value] -> [Value]
    forall a. Int -> [a] -> [a]
    take Int
    cycles [Value]
    values

      headerDate :: [Text]
    headerDate       = [Text
    "$date", [Char] -> Text
    Text.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> [Char]
    iso8601Format UTCTime
    now, Text
    "$end"]

    #ifdef CABAL
      clashVer :: [Char]
    clashVer         = Version -> [Char]
    Data.Version.showVersion Version
    Paths_clash_prelude.version
    #else
      clashVer         = "development"
    #endif
      headerVersion :: [Text]
    headerVersion    = [Text
    "$version", Text
    "Generated by Clash", [Char] -> Text
    Text.pack [Char]
    clashVer , Text
    "$end"]
      headerComment :: [Text]
    headerComment    = [Text
    "$comment", Text
    "No comment", Text
    "$end"]
      headerTimescale :: [[Char]]
    headerTimescale  = [[Char]
    "$timescale", (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    timescale) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "ps", [Char]
    "$end"]
      headerWires :: [Text]
    headerWires      = [ [Text] -> Text
    Text.unwords ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> [Char] -> [Text]
    forall {a}. Show a => a -> Char -> [Char] -> [Text]
    headerWire Int
    w Char
    l [Char]
    n
                         | (Int
    w, Char
    l, [Char]
    n) <- ([Int] -> [Char] -> [[Char]] -> [(Int, Char, [Char])]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Int]
    widths [Char]
    labels [[Char]]
    traceNames)]
      headerWire :: a -> Char -> [Char] -> [Text]
    headerWire a
    w Char
    l [Char]
    n = ([Char] -> Text) -> [[Char]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Text
    Text.pack [[Char]
    "$var wire", a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    w, [Char
    l], [Char]
    n, [Char]
    "$end"]
      initValues :: [Text]
    initValues       = ([Char] -> Text) -> [[Char]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Text
    Text.pack ([[Char]] -> [Text]) -> [[Char]] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ ((Value -> [Char]) -> Value -> [Char])
    -> [Value -> [Char]] -> [Value] -> [[Char]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Value -> [Char]) -> Value -> [Char]
    forall a b. (a -> b) -> a -> b
    ($) [Value -> [Char]]
    formatters [Value]
    inits

      formatters :: [Value -> [Char]]
    formatters = (Int -> Char -> Value -> [Char])
    -> [Int] -> [Char] -> [Value -> [Char]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Char -> Value -> [Char]
    format [Int]
    widths [Char]
    labels
      inits :: [Value]
    inits = ([Value] -> Value) -> [[Value]] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value
    -> ((Value, [Value]) -> Value) -> Maybe (Value, [Value]) -> Value
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> Value
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "dumpVCD##: empty value") (Value, [Value]) -> Value
    forall a b. (a, b) -> a
    fst (Maybe (Value, [Value]) -> Value)
    -> ([Value] -> Maybe (Value, [Value])) -> [Value] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Value] -> Maybe (Value, [Value])
    forall a. [a] -> Maybe (a, [a])
    uncons) [[Value]]
    valuess'
      tails :: [[(Bool, Value)]]
    tails = ([Value] -> [(Bool, Value)]) -> [[Value]] -> [[(Bool, Value)]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Value] -> [(Bool, Value)]
    changed [[Value]]
    valuess'

      -- | Format single value according to VCD spec
      format :: Width -> Char -> Value -> String
      format :: Int -> Char -> Value -> [Char]
    format Int
    1 Char
    label (Natural
    0,Natural
    0)   = [Char
    '0', Char
    label, Char
    '\n']
      format Int
    1 Char
    label (Natural
    0,Natural
    1)   = [Char
    '1', Char
    label, Char
    '\n']
      format Int
    1 Char
    label (Natural
    1,Natural
    _)   = [Char
    'x', Char
    label, Char
    '\n']
      format Int
    1 Char
    label (Natural
    mask,Natural
    val) =
        [Char] -> [Char]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Can't format 1 bit wide value for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. Show a => a -> [Char]
    show Char
    label [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": value " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Natural -> [Char]
    forall a. Show a => a -> [Char]
    show Natural
    val [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " and mask " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Natural -> [Char]
    forall a. Show a => a -> [Char]
    show Natural
    mask
      format Int
    n Char
    label (Natural
    mask,Natural
    val) =
        [Char]
    "b" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    digit ([Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int
    0..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1]) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    label]
        where
          digit :: Int -> Char
    digit Int
    d = case (Natural -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Natural
    mask Int
    d, Natural -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Natural
    val Int
    d) of
            (Bool
    False,Bool
    False) -> Char
    '0'
            (Bool
    False,Bool
    True)  -> Char
    '1'
            (Bool
    True,Bool
    _)      -> Char
    'x'

      -- | Given a list of values, return a list of list of bools indicating
      -- if a value changed. The first value is *not* included in the result.
      changed :: [Value] -> [(Changed, Value)]
      changed :: [Value] -> [(Bool, Value)]
    changed (Value
    s:[Value]
    ss) = [Bool] -> [Value] -> [(Bool, Value)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((Value -> Value -> Bool) -> [Value] -> [Value] -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Value -> Value -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=) (Value
    sValue -> [Value] -> [Value]
    forall a. a -> [a] -> [a]
    :[Value]
    ss) [Value]
    ss) [Value]
    ss
      changed []     = []

      bodyParts :: [Maybe Text.Text]
      bodyParts :: [Maybe Text]
    bodyParts = (Int -> Maybe Text -> Maybe Text)
    -> [Int] -> [Maybe Text] -> [Maybe Text]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Maybe Text -> Maybe Text
    go [Int
    0..] (([(Bool, Value)] -> Maybe Text)
    -> [[(Bool, Value)]] -> [Maybe Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Bool, Value)] -> Maybe Text
    bodyPart ([[(Bool, Value)]] -> [[(Bool, Value)]]
    forall a. [[a]] -> [[a]]
    Data.List.transpose [[(Bool, Value)]]
    tails))
        where
          go :: Int -> Maybe Text.Text -> Maybe Text.Text
          go :: Int -> Maybe Text -> Maybe Text
    go ([Char] -> Text
    Text.pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char]
    forall a. Show a => a -> [Char]
    show -> Text
    n) Maybe Text
    t =
            let pre :: Text
    pre = [Text] -> Text
    Text.concat [Text
    "#", Text
    n, Text
    "\n"] in
            (Text -> Text) -> Maybe Text -> Maybe Text
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> Text -> Text
    Text.append Text
    pre) Maybe Text
    t

      bodyPart :: [(Changed, Value)] -> Maybe Text.Text
      bodyPart :: [(Bool, Value)] -> Maybe Text
    bodyPart [(Bool, Value)]
    values =
        let formatted :: [(Bool, [Char])]
    formatted  = [(Bool
    c, Value -> [Char]
    f Value
    v) | (Value -> [Char]
    f, (Bool
    c,Value
    v)) <- [Value -> [Char]]
    -> [(Bool, Value)] -> [(Value -> [Char], (Bool, Value))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Value -> [Char]]
    formatters [(Bool, Value)]
    values]
            formatted' :: [Text]
    formatted' = ((Bool, [Char]) -> Text) -> [(Bool, [Char])] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> Text
    Text.pack ([Char] -> Text)
    -> ((Bool, [Char]) -> [Char]) -> (Bool, [Char]) -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, [Char]) -> [Char]
    forall a b. (a, b) -> b
    snd) ([(Bool, [Char])] -> [Text]) -> [(Bool, [Char])] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ ((Bool, [Char]) -> Bool) -> [(Bool, [Char])] -> [(Bool, [Char])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool, [Char]) -> Bool
    forall a b. (a, b) -> a
    fst ([(Bool, [Char])] -> [(Bool, [Char])])
    -> [(Bool, [Char])] -> [(Bool, [Char])]
    forall a b. (a -> b) -> a -> b
    $ [(Bool, [Char])]
    formatted in
        if [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [Text]
    formatted' then Maybe Text
    forall a. Maybe a
    Nothing else Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text] -> Text
    Text.intercalate Text
    "\n" [Text]
    formatted'

    -- | Same as @dumpVCD@, but supplied with a custom tracemap
    dumpVCD#
      :: NFDataX a
      => IORef TraceMap
      -- ^ Map with collected traces
      -> (Int, Int)
      -- ^ (offset, number of samples)
      -> Signal dom a
      -- ^ (One of) the output(s) the circuit containing the traces
      -> [String]
      -- ^ The names of the traces you definitely want to be dumped to the VCD file
      -> IO (Either String Text.Text)
    dumpVCD# :: forall a (dom :: Domain).
    NFDataX a =>
    IORef TraceMap
    -> (Int, Int)
    -> Signal dom a
    -> [[Char]]
    -> IO (Either [Char] Text)
    dumpVCD# IORef TraceMap
    traceMap (Int, Int)
    slice Signal dom a
    signal [[Char]]
    traceNames = do
      IORef TraceMap -> Signal dom a -> [[Char]] -> IO ()
    forall a (dom :: Domain).
    NFDataX a =>
    IORef TraceMap -> Signal dom a -> [[Char]] -> IO ()
    waitForTraces# IORef TraceMap
    traceMap Signal dom a
    signal [[Char]]
    traceNames
      m <- IORef TraceMap -> IO TraceMap
    forall a. IORef a -> IO a
    readIORef IORef TraceMap
    traceMap
      fmap (dumpVCD## slice m) getCurrentTime

    -- | Produce a four-state VCD (Value Change Dump) according to IEEE
    -- 1364-{1995,2001}. This function fails if a trace name contains either
    -- non-printable or non-VCD characters.
    --
    -- Due to lazy evaluation, the created VCD files might not contain all the
    -- traces you were expecting. You therefore have to provide a list of names
    -- you definately want to be dumped in the VCD file.
    --
    -- For example:
    --
    -- @
    -- vcd <- dumpVCD (0, 100) cntrOut ["main", "sub"]
    -- @
    --
    -- Evaluates /cntrOut/ long enough in order for to guarantee that the @main@,
    -- and @sub@ traces end up in the generated VCD file.
    dumpVCD
      :: NFDataX a
      => (Int, Int)
      -- ^ (offset, number of samples)
      -> Signal dom a
      -- ^ (One of) the outputs of the circuit containing the traces
      -> [String]
      -- ^ The names of the traces you definitely want to be dumped in the VCD file
      -> IO (Either String Text.Text)
    dumpVCD :: forall a (dom :: Domain).
    NFDataX a =>
    (Int, Int) -> Signal dom a -> [[Char]] -> IO (Either [Char] Text)
    dumpVCD = IORef TraceMap
    -> (Int, Int)
    -> Signal dom a
    -> [[Char]]
    -> IO (Either [Char] Text)
    forall a (dom :: Domain).
    NFDataX a =>
    IORef TraceMap
    -> (Int, Int)
    -> Signal dom a
    -> [[Char]]
    -> IO (Either [Char] Text)
    dumpVCD# IORef TraceMap
    traceMap#

    -- | Dump a number of samples to a replayable bytestring.
    dumpReplayable
      :: forall a dom
       . NFDataX a
      => Int
      -- ^ Number of samples
      -> Signal dom a
      -- ^ (One of) the outputs of the circuit containing the traces
      -> String
      -- ^ Name of trace to dump
      -> IO ByteString
    dumpReplayable :: forall a (dom :: Domain).
    NFDataX a =>
    Int -> Signal dom a -> [Char] -> IO TypeRepBS
    dumpReplayable Int
    n Signal dom a
    oSignal [Char]
    traceName = do
      IORef TraceMap -> Signal dom a -> [[Char]] -> IO ()
    forall a (dom :: Domain).
    NFDataX a =>
    IORef TraceMap -> Signal dom a -> [[Char]] -> IO ()
    waitForTraces# IORef TraceMap
    traceMap# Signal dom a
    oSignal [[Char]
    traceName]
      replaySignal <- (TraceMap -> [Char] -> (TypeRepBS, Int, Int, [Value])
    forall k a. Ord k => Map k a -> k -> a
    Map.! [Char]
    traceName) (TraceMap -> (TypeRepBS, Int, Int, [Value]))
    -> IO TraceMap -> IO (TypeRepBS, Int, Int, [Value])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef TraceMap -> IO TraceMap
    forall a. IORef a -> IO a
    readIORef IORef TraceMap
    traceMap#
      let (tRep, _period, _width, samples) = replaySignal
      pure (ByteStringLazy.concat (tRep : map encode (take n samples)))

    -- | Take a serialized signal (dumped with @dumpReplayable@) and convert it
    -- back into a signal. Will error if dumped type does not match requested
    -- type. The first value in the signal that fails to decode will stop the
    -- decoding process and yield an error. Not that this always happens if you
    -- evaluate more values than were originally dumped.
    replay
      :: forall a dom n
       . ( Typeable a
         , NFDataX a
         , BitPack a
         , KnownNat n
         , n ~ BitSize a )
      => ByteString
      -> Either String (Signal dom a)
    replay :: forall a (dom :: Domain) (n :: Natural).
    (Typeable a, NFDataX a, BitPack a, KnownNat n, n ~ BitSize a) =>
    TypeRepBS -> Either [Char] (Signal dom a)
    replay TypeRepBS
    bytes0 = Either [Char] (Signal dom a)
    samples1
     where
      samples1 :: Either [Char] (Signal dom a)
    samples1 =
        case TypeRepBS
    -> Either
         (TypeRepBS, ByteOffset, [Char]) (TypeRepBS, ByteOffset, TypeRep a)
    forall a.
    Binary a =>
    TypeRepBS
    -> Either
         (TypeRepBS, ByteOffset, [Char]) (TypeRepBS, ByteOffset, a)
    decodeOrFail TypeRepBS
    bytes0 of
          Left (TypeRepBS
    _, ByteOffset
    _, [Char]
    err) ->
            [Char] -> Either [Char] (Signal dom a)
    forall a b. a -> Either a b
    Left ([Char]
    "Failed to decode typeRep. Parser reported:\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err)
          Right (TypeRepBS
    bytes1, ByteOffset
    _, TypeRep a
    _ :: TypeRep a) ->
            let samples0 :: [Either [Char] a]
    samples0 = TypeRepBS -> [Either [Char] a]
    forall a (n :: Natural).
    (BitPack a, KnownNat n, n ~ BitSize a) =>
    TypeRepBS -> [Either [Char] a]
    decodeSamples TypeRepBS
    bytes1 in
            let err :: [Char]
    err = [Char]
    "Failed to decode value in signal. Parser reported:\n\n " in
            Signal dom a -> Either [Char] (Signal dom a)
    forall a b. b -> Either a b
    Right ([a] -> Signal dom a
    forall a (dom :: Domain). NFDataX a => [a] -> Signal dom a
    fromList ((Either [Char] a -> a) -> [Either [Char] a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (([Char] -> a) -> (a -> a) -> Either [Char] a -> a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> ([Char] -> [Char]) -> [Char] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char]
    err [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++)) a -> a
    forall a. a -> a
    id) [Either [Char] a]
    samples0))

    -- | Helper function of 'replay'. Decodes ByteString to some type with
    -- BitVector as an intermediate type.
    decodeSamples
      :: forall a n
       . ( BitPack a
         , KnownNat n
         , n ~ BitSize a )
      => ByteString
      -> [Either String a]
    decodeSamples :: forall a (n :: Natural).
    (BitPack a, KnownNat n, n ~ BitSize a) =>
    TypeRepBS -> [Either [Char] a]
    decodeSamples TypeRepBS
    bytes0 =
      case TypeRepBS
    -> Either
         (TypeRepBS, ByteOffset, [Char]) (TypeRepBS, ByteOffset, Value)
    forall a.
    Binary a =>
    TypeRepBS
    -> Either
         (TypeRepBS, ByteOffset, [Char]) (TypeRepBS, ByteOffset, a)
    decodeOrFail TypeRepBS
    bytes0 of
        Left (TypeRepBS
    _, ByteOffset
    _, [Char]
    err) ->
          [[Char] -> Either [Char] a
    forall a b. a -> Either a b
    Left [Char]
    err]
        Right (TypeRepBS
    bytes1, ByteOffset
    _, (Natural
    m, Natural
    v)) ->
          (a -> Either [Char] a
    forall a b. b -> Either a b
    Right (BitVector (BitSize a) -> a
    forall a. BitPack a => BitVector (BitSize a) -> a
    unpack (Natural -> Natural -> BitVector n
    forall (n :: Natural). Natural -> Natural -> BitVector n
    BV Natural
    m Natural
    v))) Either [Char] a -> [Either [Char] a] -> [Either [Char] a]
    forall a. a -> [a] -> [a]
    : TypeRepBS -> [Either [Char] a]
    forall a (n :: Natural).
    (BitPack a, KnownNat n, n ~ BitSize a) =>
    TypeRepBS -> [Either [Char] a]
    decodeSamples TypeRepBS
    bytes1

    -- | Keep evaluating given signal until all trace names are present.
    waitForTraces#
      :: NFDataX a
      => IORef TraceMap
      -- ^ Map with collected traces
      -> Signal dom a
      -- ^ (One of) the output(s) the circuit containing the traces
      -> [String]
      -- ^ The names of the traces you definitely want to be dumped to the VCD file
      -> IO ()
    waitForTraces# :: forall a (dom :: Domain).
    NFDataX a =>
    IORef TraceMap -> Signal dom a -> [[Char]] -> IO ()
    waitForTraces# IORef TraceMap
    traceMap Signal dom a
    signal [[Char]]
    traceNames = do
      IORef TraceMap -> TraceMap -> IO ()
    forall a. IORef a -> a -> IO ()
    atomicWriteIORef IORef TraceMap
    traceMap TraceMap
    forall k a. Map k a
    Map.empty
      rest <- (Signal dom a -> [Char] -> IO (Signal dom a))
    -> Signal dom a -> [[Char]] -> IO (Signal dom a)
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Signal dom a -> [Char] -> IO (Signal dom a)
    go Signal dom a
    signal [[Char]]
    traceNames
      seq rest (return ())
     where
      go :: Signal dom a -> [Char] -> IO (Signal dom a)
    go (a
    s0 :- Signal dom a
    ss) [Char]
    nm = do
        m <- IORef TraceMap -> IO TraceMap
    forall a. IORef a -> IO a
    readIORef IORef TraceMap
    traceMap
        if Map.member nm m then
          deepseqX s0 (return ss)
        else
          deepseqX
            s0
            (go ss nm)