    {-|
      Copyright   :  (C) 2012-2016, University of Twente,
                         2016-2017, Myrtle Software Ltd,
                         2017     , QBayLogic, Google Inc.
                         2020-2023, QBayLogic,
                         2022     , Google Inc.

      License     :  BSD2 (see the file LICENSE)
      Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

      Module that connects all the parts of the Clash compiler library
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}

    module Clash.Driver where

    import           Control.Concurrent               (MVar, modifyMVar, modifyMVar_, newMVar, withMVar)
    import           Control.Concurrent.Async         (mapConcurrently_)
    import qualified Control.Concurrent.Supply        as Supply
    import           Control.DeepSeq
    import           Control.Exception                (throw)
    import qualified Control.Monad                    as Monad
    import           Control.Monad                    (unless, foldM, forM, filterM)
    import           Control.Monad.Catch              (MonadMask)
    import           Control.Monad.Extra              (whenM, ifM, unlessM)
    import           Control.Monad.IO.Class           (MonadIO)
    import           Control.Monad.State              (evalState, get)
    import           Control.Monad.State.Strict       (State)
    import qualified Control.Monad.State.Strict       as State
    import qualified Crypto.Hash.SHA256               as Sha256
    import           Data.Bifunctor                   (first, second)
    import           Data.ByteString                  (ByteString)
    import qualified Data.ByteString                  as ByteString
    import qualified Data.ByteString.Lazy             as ByteStringLazy
    import qualified Data.ByteString.Lazy.Char8       as ByteStringLazyChar8
    import           Data.Char                        (isAscii, isAlphaNum)
    import           Data.Default
    import           Data.Hashable                    (hash)
    import           Data.HashMap.Strict              (HashMap)
    import qualified Data.HashMap.Strict              as HashMap
    import qualified Data.HashSet                     as HashSet
    import           Data.Proxy                       (Proxy(..))
    import           Data.List                        (intercalate)
    import qualified Data.List                        as List
    import           Data.Maybe                       (fromMaybe, maybeToList, mapMaybe)
    import qualified Data.Map.Ordered                 as OMap
    import           Data.Map.Ordered.Extra           ()
    import           Data.Monoid                      (Ap(..))
    import qualified Data.Text
    import           Data.Text.Lazy                   (Text)
    import qualified Data.Text.Lazy                   as Text
    import           Data.Text.Lazy.Encoding          as Text
    import qualified Data.Text.Lazy.IO                as Text
    #if MIN_VERSION_prettyprinter(1,7,0)
    import           Prettyprinter (pretty)
    #else
    import           Data.Text.Prettyprint.Doc (pretty)
    #endif
    import           Data.Text.Prettyprint.Doc.Extra
      (Doc, LayoutOptions (..), PageWidth (..) , layoutPretty, renderLazy)
    import qualified Data.Time.Clock                  as Clock
    import           GHC.Stack                        (HasCallStack)
    import qualified Language.Haskell.Interpreter     as Hint
    import qualified Language.Haskell.Interpreter.Extension as Hint
    import qualified Language.Haskell.Interpreter.Unsafe as Hint
    import qualified System.Directory                 as Directory
    import           System.Directory
      (doesPathExist, listDirectory, doesDirectoryExist, createDirectoryIfMissing,
       removeDirectoryRecursive, doesFileExist)
    import           System.Environment               (getExecutablePath)
    import           System.FilePath                  ((</>), (<.>), takeDirectory, takeFileName, isAbsolute)
    import qualified System.FilePath                  as FilePath
    import qualified System.IO                        as IO
    import           System.IO.Temp
      (getCanonicalTemporaryDirectory, withTempDirectory)
    import           Text.Trifecta.Result
      (Result(Success, Failure), _errDoc)

    #if MIN_VERSION_ghc(9,0,0)
    import           GHC.Builtin.Names                 (eqTyConKey, ipClassKey)
    import           GHC.Types.Unique                  (getKey)

    import           GHC.Types.SrcLoc                  (SrcSpan)
    #else
    import           PrelNames               (eqTyConKey, ipClassKey)
    import           Unique                  (getKey)

    import           SrcLoc                           (SrcSpan)
    #endif
    import           GHC.BasicTypes.Extra             ()

    import           Clash.Annotations.Primitive
      (HDL (..))
    import           Clash.Annotations.BitRepresentation.Internal
      (CustomReprs)
    import           Clash.Annotations.TopEntity
      (TopEntity (..), PortName(PortName, PortProduct))
    import           Clash.Annotations.TopEntity.Extra ()
    import           Clash.Backend
    import           Clash.Core.PartialEval as PE     (Evaluator)
    import           Clash.Core.Evaluator.Types as WHNF (Evaluator)
    import           Clash.Core.HasType
    import           Clash.Core.Name                  (Name (..))
    import           Clash.Core.Pretty                (PrettyOptions(..), showPpr')
    import           Clash.Core.Type
      (Type(ForAllTy, LitTy, AnnType), TypeView(..), tyView, mkFunTy, LitTy(SymTy))
    import           Clash.Core.TyCon                 (TyConMap)
    import           Clash.Core.Util                  (shouldSplit)
    import           Clash.Core.Var
      (Id, varName, varUniq, varType)
    import           Clash.Core.VarEnv
      (elemVarEnv, emptyVarEnv, lookupVarEnv, lookupVarEnv', mkVarEnv, lookupVarEnvDirectly, eltsVarEnv, VarEnv)
    import           Clash.Debug                      (debugIsOn)
    import           Clash.Driver.Types
    import           Clash.Driver.Manifest
      (Manifest(..), readFreshManifest, UnexpectedModification, pprintUnexpectedModifications,
       mkManifest, writeManifest, manifestFilename)
    import           Clash.Edalize.Edam
    import           Clash.Netlist                    (genNetlist, genTopNames)
    import           Clash.Netlist.BlackBox.Parser    (runParse)
    import           Clash.Netlist.BlackBox.Types     (BlackBoxTemplate, BlackBoxFunction)
    import qualified Clash.Netlist.Id                 as Id
    import           Clash.Netlist.Types
      (IdentifierText, BlackBox (..), Component (..), FilteredHWType, HWMap, SomeBackend (..),
       TopEntityT(..), TemplateFunction, ComponentMap, findClocks, ComponentMeta(..))
    import           Clash.Normalize                  (checkNonRecursive, cleanupGraph,
                                                       normalize, runNormalization)
    import           Clash.Normalize.Util             (callGraph, tvSubstWithTyEq)
    import qualified Clash.Primitives.Sized.Signed    as P
    import qualified Clash.Primitives.Sized.ToInteger as P
    import qualified Clash.Primitives.Sized.Vector    as P
    import qualified Clash.Primitives.GHC.Int         as P
    import qualified Clash.Primitives.GHC.Word        as P
    import qualified Clash.Primitives.Intel.ClockGen  as P
    import qualified Clash.Primitives.Magic           as P
    import qualified Clash.Primitives.Verification    as P
    import qualified Clash.Primitives.Xilinx.ClockGen as P
    import           Clash.Primitives.Types
    import           Clash.Signal.Internal
    import           Clash.Unique                     (Unique, getUnique)
    import           Clash.Util
      (ClashException(..), reportTimeDiff,
       wantedLanguageExtensions, unwantedLanguageExtensions, curLoc)
    import           Clash.Util.Graph                 (reverseTopSort)
    import qualified Clash.Util.Interpolate           as I

    -- | Worker function of 'splitTopEntityT'
    splitTopAnn
      :: TyConMap
      -> SrcSpan
      -- ^ Source location of top entity (for error reporting)
      -> Type
      -- ^ Top entity body
      -> TopEntity
      -- ^ Port annotations for top entity
      -> TopEntity
      -- ^ New top entity with split ports (or the old one if not applicable)
    splitTopAnn :: TyConMap -> SrcSpan -> Type -> TopEntity -> TopEntity
    splitTopAnn TyConMap
    tcm SrcSpan
    sp typ :: Type
    typ@(Type -> TypeView
    tyView -> FunTy {}) t :: TopEntity
    t@Synthesize{[PortName]
    t_inputs :: [PortName]
    t_inputs :: TopEntity -> [PortName]
    t_inputs} =
      TopEntity
    t{t_inputs=go typ t_inputs}
     where
      go :: Type -> [PortName] -> [PortName]
      go :: Type -> [PortName] -> [PortName]
    go Type
    _ [] = []
      go (Type -> TypeView
    tyView -> FunTy Type
    a Type
    res) (PortName
    p:[PortName]
    ps)
       | Type -> Bool
    shouldNotHavePortName Type
    a
         -- Insert dummy PortName for args for which the user shouldn't have
         -- to provide a name.
         -- Ideally this would be any (non Hidden{Clock,Reset,Enable}) constraint.
         -- But because we can't properly detect constraints,
         -- we only skip some specific one. see "shouldNotHavePortName"
         = String -> PortName
    PortName String
    "" PortName -> [PortName] -> [PortName]
    forall a. a -> [a] -> [a]
    : Type -> [PortName] -> [PortName]
    go Type
    res (PortName
    pPortName -> [PortName] -> [PortName]
    forall a. a -> [a] -> [a]
    :[PortName]
    ps)
       | Bool
    otherwise =
        case TyConMap -> Type -> Maybe ([Term] -> Term, Projections, [Type])
    shouldSplit TyConMap
    tcm Type
    a of
          Just ([Term] -> Term
    _,Projections
    _,argTys :: [Type]
    argTys@(Type
    _:Type
    _:[Type]
    _)) ->
            -- Port must be split up into 'n' pieces.. can it?
            case PortName
    p of
              PortProduct String
    nm [PortName]
    portNames0 ->
                let
                  n :: Unique
    n = [Type] -> Unique
    forall a. [a] -> Unique
    forall (t :: Type -> Type) a. Foldable t => t a -> Unique
    length [Type]
    argTys
                  newPortNames :: [PortName]
    newPortNames = (Unique -> PortName) -> [Unique] -> [PortName]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> PortName
    PortName (String -> PortName) -> (Unique -> String) -> Unique -> PortName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unique -> String
    forall a. Show a => a -> String
    show) [(Unique
    0::Int)..]
                  portNames1 :: [PortName]
    portNames1 = (PortName -> PortName) -> [PortName] -> [PortName]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> PortName -> PortName
    prependName String
    nm) ([PortName]
    portNames0 [PortName] -> [PortName] -> [PortName]
    forall a. [a] -> [a] -> [a]
    ++ [PortName]
    newPortNames)
                  newLam :: Type
    newLam = (Type -> Type -> Type) -> [Type] -> Type
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> a -> a) -> t a -> a
    foldr1 Type -> Type -> Type
    mkFunTy ([Type]
    argTys [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type
    res])
                in
                  Type -> [PortName] -> [PortName]
    go Type
    newLam (Unique -> [PortName] -> [PortName]
    forall a. Unique -> [a] -> [a]
    take Unique
    n [PortName]
    portNames1 [PortName] -> [PortName] -> [PortName]
    forall a. [a] -> [a] -> [a]
    ++ [PortName]
    ps)
              PortName String
    nm ->
                ClashException -> [PortName]
    forall a e. Exception e => e -> a
    throw ((String -> Maybe String -> ClashException)
    -> Maybe String -> String -> ClashException
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (SrcSpan -> String -> Maybe String -> ClashException
    ClashException SrcSpan
    sp) Maybe String
    forall a. Maybe a
    Nothing (String -> ClashException) -> String -> ClashException
    forall a b. (a -> b) -> a -> b
    $ [I.i|
                  Couldn't separate clock, reset, or enable from a product type due
                  to a malformed Synthesize annotation. All clocks, resets, and
                  enables should be given a unique port name. Type to be split:

                    #{showPpr' (PrettyOptions False True False False) a}

                  Given port annotation: #{p}. You might want to use the
                  following instead: PortProduct #{show nm} []. This allows Clash to
                  autogenerate names based on the name #{show nm}.
                |])
          Maybe ([Term] -> Term, Projections, [Type])
    _ ->
            -- No need to split the port, carrying on..
            PortName
    p PortName -> [PortName] -> [PortName]
    forall a. a -> [a] -> [a]
    : Type -> [PortName] -> [PortName]
    go Type
    res [PortName]
    ps
      go (ForAllTy TyVar
    _tyVar Type
    ty) [PortName]
    ps = Type -> [PortName] -> [PortName]
    go Type
    ty [PortName]
    ps
      go Type
    _ty [PortName]
    ps = [PortName]
    ps

      prependName :: String -> PortName -> PortName
      prependName :: String -> PortName -> PortName
    prependName String
    "" PortName
    pn = PortName
    pn
      prependName String
    p (PortProduct String
    nm [PortName]
    ps) = String -> [PortName] -> PortName
    PortProduct (String
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    nm) [PortName]
    ps
      prependName String
    p (PortName String
    nm) = String -> PortName
    PortName (String
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    nm)

      -- Returns True for
      --   * type equality constraints (~)
      --   * HasCallStack
      shouldNotHavePortName :: Type -> Bool
      shouldNotHavePortName :: Type -> Bool
    shouldNotHavePortName (Type -> TypeView
    tyView -> TyConApp (TyConName -> Unique
    forall a. Name a -> Unique
    nameUniq -> Unique
    tcUniq) [Type]
    tcArgs)
        | Unique
    tcUniq Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique -> Unique
    getKey Unique
    eqTyConKey = Bool
    True
        | Unique
    tcUniq Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique -> Unique
    getKey Unique
    ipClassKey
        , [LitTy (SymTy String
    "callStack"), Type
    _] <- [Type]
    tcArgs = Bool
    True
      shouldNotHavePortName Type
    _ = Bool
    False

    splitTopAnn TyConMap
    tcm SrcSpan
    sp (ForAllTy TyVar
    _tyVar Type
    typ) TopEntity
    t = TyConMap -> SrcSpan -> Type -> TopEntity -> TopEntity
    splitTopAnn TyConMap
    tcm SrcSpan
    sp Type
    typ TopEntity
    t
    splitTopAnn TyConMap
    tcm SrcSpan
    sp (AnnType [Attr Text]
    _anns Type
    typ) TopEntity
    t = TyConMap -> SrcSpan -> Type -> TopEntity -> TopEntity
    splitTopAnn TyConMap
    tcm SrcSpan
    sp Type
    typ TopEntity
    t
    splitTopAnn TyConMap
    _tcm SrcSpan
    _sp Type
    _typ TopEntity
    t = TopEntity
    t

    -- When splitting up a single argument into multiple arguments (see docs of
    -- 'separateArguments') we should make sure to update TopEntity annotations
    -- accordingly. See: https://github.com/clash-lang/clash-compiler/issues/1033
    splitTopEntityT
      :: HasCallStack
      => TyConMap
      -> BindingMap
      -> TopEntityT
      -> TopEntityT
    splitTopEntityT :: HasCallStack => TyConMap -> BindingMap -> TopEntityT -> TopEntityT
    splitTopEntityT TyConMap
    tcm BindingMap
    bindingsMap tt :: TopEntityT
    tt@(TopEntityT Id
    id_ (Just t :: TopEntity
    t@(Synthesize {})) Bool
    _) =
      case Id -> BindingMap -> Maybe (Binding Term)
    forall b a. Var b -> VarEnv a -> Maybe a
    lookupVarEnv Id
    id_ BindingMap
    bindingsMap of
        Just (Binding Id
    _id SrcSpan
    sp InlineSpec
    _ IsPrim
    _ Term
    _ Bool
    _) ->
          TopEntityT
    tt{topAnnotation=Just (splitTopAnn tcm sp (coreTypeOf id_) t)}
        Maybe (Binding Term)
    Nothing ->
          String -> TopEntityT
    forall a. HasCallStack => String -> a
    error String
    "Internal error in 'splitTopEntityT'. Please report as a bug."
    splitTopEntityT TyConMap
    _ BindingMap
    _ TopEntityT
    t = TopEntityT
    t

    -- | Remove constraints such as 'a ~ 3'.
    removeForAll :: TopEntityT -> TopEntityT
    removeForAll :: TopEntityT -> TopEntityT
    removeForAll (TopEntityT Id
    var Maybe TopEntity
    annM Bool
    isTb) =
      Id -> Maybe TopEntity -> Bool -> TopEntityT
    TopEntityT Id
    var{varType=tvSubstWithTyEq (coreTypeOf var)} Maybe TopEntity
    annM Bool
    isTb

    -- | Given a list of all found top entities and _maybe_ a top entity (+dependencies)
    -- passed in by '-main-is', return the list of top entities Clash needs to
    -- compile.
    selectTopEntities :: [TopEntityT] -> Maybe (TopEntityT, [TopEntityT]) -> [TopEntityT]
    selectTopEntities :: [TopEntityT] -> Maybe (TopEntityT, [TopEntityT]) -> [TopEntityT]
    selectTopEntities [TopEntityT]
    topEntities Maybe (TopEntityT, [TopEntityT])
    mainTopEntity =
      [TopEntityT]
    -> ((TopEntityT, [TopEntityT]) -> [TopEntityT])
    -> Maybe (TopEntityT, [TopEntityT])
    -> [TopEntityT]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [TopEntityT]
    topEntities ((TopEntityT -> [TopEntityT] -> [TopEntityT])
    -> (TopEntityT, [TopEntityT]) -> [TopEntityT]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (:)) Maybe (TopEntityT, [TopEntityT])
    mainTopEntity

    -- | Get modification data of current clash binary.
    getClashModificationDate :: IO Clock.UTCTime
    getClashModificationDate :: IO UTCTime
    getClashModificationDate = String -> IO UTCTime
    Directory.getModificationTime (String -> IO UTCTime) -> IO String -> IO UTCTime
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO String
    getExecutablePath

    hdlFromBackend :: forall backend. Backend backend => Proxy backend -> HDL
    hdlFromBackend :: forall backend. Backend backend => Proxy backend -> HDL
    hdlFromBackend Proxy backend
    _ = backend -> HDL
    forall state. Backend state => state -> HDL
    hdlKind (backend
    forall a. HasCallStack => a
    undefined :: backend)

    replaceChar :: Char -> Char -> String -> String
    replaceChar :: Char -> Char -> String -> String
    replaceChar Char
    a Char
    b = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    go
     where
      go :: Char -> Char
    go Char
    c
        | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    a = Char
    b
        | Bool
    otherwise = Char
    c

    removeHistoryFile :: Maybe FilePath -> IO ()
    removeHistoryFile :: Maybe String -> IO ()
    removeHistoryFile =
      IO () -> (String -> IO ()) -> Maybe String -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ()) String -> IO ()
    removeHistory
     where
      removeHistory :: String -> IO ()
    removeHistory String
    path =
        IO Bool -> IO () -> IO ()
    forall (m :: Type -> Type). Monad m => m Bool -> m () -> m ()
    whenM (String -> IO Bool
    Directory.doesFileExist String
    path) (String -> IO ()
    Directory.removeFile String
    path)

    prefixModuleName
      :: HDL
      -> Maybe Data.Text.Text
      -> Maybe TopEntity
      -> String
      -> (String, Maybe String)
    prefixModuleName :: HDL
    -> Maybe Text
    -> Maybe TopEntity
    -> String
    -> (String, Maybe String)
    prefixModuleName HDL
    hdl Maybe Text
    compPrefix Maybe TopEntity
    annM String
    modName =
      case Maybe Text
    compPrefix of
        Just (Text -> String
    Data.Text.unpack -> String
    p)
          | Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null String
    p) -> case Maybe TopEntity
    annM of
              Just TopEntity
    ann ->
                let nm :: String
    nm = String
    p String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "_" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> TopEntity -> String
    t_name TopEntity
    ann
                 in (String
    nm, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    nm)

              Maybe TopEntity
    Nothing ->
                (String
    p String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "_" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    modName, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    p)

          | Just TopEntity
    ann <- Maybe TopEntity
    annM -> case HDL
    hdl of
              HDL
    VHDL -> (TopEntity -> String
    t_name TopEntity
    ann, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    modName)
              HDL
    _ -> (TopEntity -> String
    t_name TopEntity
    ann, Maybe String
    forall a. Maybe a
    Nothing)

        Maybe Text
    _ -> case Maybe TopEntity
    annM of
          Just TopEntity
    ann -> case HDL
    hdl of
            HDL
    VHDL -> (TopEntity -> String
    t_name TopEntity
    ann, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    modName)
            HDL
    _ -> (TopEntity -> String
    t_name TopEntity
    ann, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    modName)
          Maybe TopEntity
    _ -> (String
    modName, Maybe String
    forall a. Maybe a
    Nothing)

    -- | Create a set of target HDL files for a set of functions
    generateHDL
      :: forall backend . Backend backend
      => ClashEnv
      -> ClashDesign
      -> Maybe backend
      -> (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -- ^ Hardcoded 'Type' -> 'HWType' translator
      -> PE.Evaluator
      -- ^ Hardcoded evaluator for partial evaluation
      -> WHNF.Evaluator
      -- ^ Hardcoded evaluator for WHNF (old evaluator)
      -> Maybe (TopEntityT, [TopEntityT])
      -- ^ Main top entity to compile. If Nothing, all top entities in the
      -- 'ClashDesign' argument will be compiled.
      -> Clock.UTCTime
      -> IO ()
    generateHDL :: forall backend.
    Backend backend =>
    ClashEnv
    -> ClashDesign
    -> Maybe backend
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either String FilteredHWType)))
    -> Evaluator
    -> Evaluator
    -> Maybe (TopEntityT, [TopEntityT])
    -> UTCTime
    -> IO ()
    generateHDL ClashEnv
    env ClashDesign
    design Maybe backend
    hdlState CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either String FilteredHWType))
    typeTrans Evaluator
    peEval Evaluator
    eval Maybe (TopEntityT, [TopEntityT])
    mainTopEntity UTCTime
    startTime = do
        let bindingsMap :: BindingMap
    bindingsMap = ClashDesign -> BindingMap
    designBindings ClashDesign
    design
        let tcm :: TyConMap
    tcm = ClashEnv -> TyConMap
    envTyConMap ClashEnv
    env
        let topEntities0 :: [TopEntityT]
    topEntities0 = ClashDesign -> [TopEntityT]
    designEntities ClashDesign
    design
        let opts :: ClashOpts
    opts = ClashEnv -> ClashOpts
    envOpts ClashEnv
    env

        Maybe String -> IO ()
    removeHistoryFile (DebugOpts -> Maybe String
    dbg_historyFile (ClashOpts -> DebugOpts
    opt_debug ClashOpts
    opts))

        Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless (ClashOpts -> Bool
    opt_cachehdl ClashOpts
    opts) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          String -> IO ()
    putStrLn String
    "Clash: Ignoring previously made caches"

        let topEntities1 :: [TopEntityT]
    topEntities1 = (TopEntityT -> TopEntityT) -> [TopEntityT] -> [TopEntityT]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TopEntityT -> TopEntityT
    removeForAll (TopEntityT -> TopEntityT)
    -> (TopEntityT -> TopEntityT) -> TopEntityT -> TopEntityT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => TyConMap -> BindingMap -> TopEntityT -> TopEntityT
    TyConMap -> BindingMap -> TopEntityT -> TopEntityT
    splitTopEntityT TyConMap
    tcm BindingMap
    bindingsMap)
                             ([TopEntityT] -> Maybe (TopEntityT, [TopEntityT]) -> [TopEntityT]
    selectTopEntities [TopEntityT]
    topEntities0 Maybe (TopEntityT, [TopEntityT])
    mainTopEntity)
            hdl :: HDL
    hdl = Proxy backend -> HDL
    forall backend. Backend backend => Proxy backend -> HDL
    hdlFromBackend (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @backend)
            (VarEnv Identifier
    compNames, IdentifierSet
    initIs) = ClashOpts
    -> HDL -> [TopEntityT] -> (VarEnv Identifier, IdentifierSet)
    genTopNames ClashOpts
    opts HDL
    hdl [TopEntityT]
    topEntities1
            ([TopEntityT]
    tes, HashMap Unique [Unique]
    deps) = BindingMap
    -> [TopEntityT] -> ([TopEntityT], HashMap Unique [Unique])
    sortTop BindingMap
    bindingsMap [TopEntityT]
    topEntities1

        -- TODO This is here because of some minimal effort refactoring. At some
        -- point generateHDL should be better laid out so this can be closer to
        -- the few places it is needed.
        let topEntityMap :: VarEnv TopEntityT
    topEntityMap = [(Id, TopEntityT)] -> VarEnv TopEntityT
    forall a b. [(Var a, b)] -> VarEnv b
    mkVarEnv ((TopEntityT -> (Id, TopEntityT))
    -> [TopEntityT] -> [(Id, TopEntityT)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\TopEntityT
    x -> (TopEntityT -> Id
    topId TopEntityT
    x, TopEntityT
    x)) [TopEntityT]
    topEntities1)

        -- Data which is updated and used when updating the different top entities
        -- is kept in an MVar.
        MVar IdentifierSet
    idSet <- IdentifierSet -> IO (MVar IdentifierSet)
    forall a. a -> IO (MVar a)
    newMVar IdentifierSet
    initIs
        MVar (HashMap Unique [EdamFile])
    edamFiles <- HashMap Unique [EdamFile] -> IO (MVar (HashMap Unique [EdamFile]))
    forall a. a -> IO (MVar a)
    newMVar HashMap Unique [EdamFile]
    forall k v. HashMap k v
    HashMap.empty
        MVar ()
    ioLock <- () -> IO (MVar ())
    forall a. a -> IO (MVar a)
    newMVar ()

        (TopEntityT -> IO ()) -> [TopEntityT] -> IO ()
    forall (f :: Type -> Type) a b.
    Foldable f =>
    (a -> IO b) -> f a -> IO ()
    mapConcurrently_ (VarEnv Identifier
    -> MVar IdentifierSet
    -> MVar (HashMap Unique [EdamFile])
    -> MVar ()
    -> HashMap Unique [Unique]
    -> VarEnv TopEntityT
    -> TopEntityT
    -> IO ()
    go VarEnv Identifier
    compNames MVar IdentifierSet
    idSet MVar (HashMap Unique [EdamFile])
    edamFiles MVar ()
    ioLock HashMap Unique [Unique]
    deps VarEnv TopEntityT
    topEntityMap) [TopEntityT]
    tes

        UTCTime
    time <- IO UTCTime
    Clock.getCurrentTime
        let diff :: String
    diff = UTCTime -> UTCTime -> String
    reportTimeDiff UTCTime
    time UTCTime
    startTime
        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Clash: Total compilation took " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    diff
     where
      go
        :: VarEnv Id.Identifier
        -> MVar Id.IdentifierSet
        -> MVar (HashMap Unique [EdamFile])
        -> MVar ()
        -> HashMap Unique [Unique]
        -> VarEnv TopEntityT
        -> TopEntityT
        -> IO ()
      go :: VarEnv Identifier
    -> MVar IdentifierSet
    -> MVar (HashMap Unique [EdamFile])
    -> MVar ()
    -> HashMap Unique [Unique]
    -> VarEnv TopEntityT
    -> TopEntityT
    -> IO ()
    go VarEnv Identifier
    compNames MVar IdentifierSet
    seenV MVar (HashMap Unique [EdamFile])
    edamFilesV MVar ()
    ioLockV HashMap Unique [Unique]
    deps VarEnv TopEntityT
    topEntityMap (TopEntityT Id
    topEntity Maybe TopEntity
    annM Bool
    isTb) = do
      let domainConfs :: DomainMap
    domainConfs = ClashEnv -> DomainMap
    envDomains ClashEnv
    env
      let bindingsMap :: BindingMap
    bindingsMap = ClashDesign -> BindingMap
    designBindings ClashDesign
    design
      let primMap :: CompiledPrimMap
    primMap = ClashEnv -> CompiledPrimMap
    envPrimitives ClashEnv
    env
      let topEntities0 :: [TopEntityT]
    topEntities0 = ClashDesign -> [TopEntityT]
    designEntities ClashDesign
    design
      let opts :: ClashOpts
    opts = ClashEnv -> ClashOpts
    envOpts ClashEnv
    env
      UTCTime
    prevTime <- IO UTCTime
    Clock.getCurrentTime
      let topEntityS :: String
    topEntityS = Text -> String
    Data.Text.unpack (Name Term -> Text
    forall a. Name a -> Text
    nameOcc (Id -> Name Term
    forall a. Var a -> Name a
    varName Id
    topEntity))

      MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    ioLockV ((() -> IO ()) -> IO ())
    -> (IO () -> () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        String -> IO ()
    putStrLn (String
    "Clash: Compiling " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    topEntityS)

      let modName1 :: String
    modName1 = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Char
    c -> Char -> Bool
    isAscii Char
    c Bool -> Bool -> Bool
    && (Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_')) (Char -> Char -> String -> String
    replaceChar Char
    '.' Char
    '_' String
    topEntityS)

      MVar IdentifierSet -> (IdentifierSet -> IO IdentifierSet) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar IdentifierSet
    seenV ((IdentifierSet -> IO IdentifierSet) -> IO ())
    -> (IdentifierSet -> IO IdentifierSet) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IdentifierSet
    seen ->
        IdentifierSet -> IO IdentifierSet
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (IdentifierSet -> IO IdentifierSet)
    -> IdentifierSet -> IO IdentifierSet
    forall a b. (a -> b) -> a -> b
    $! State IdentifierSet Identifier -> IdentifierSet -> IdentifierSet
    forall s a. State s a -> s -> s
    State.execState (Text -> State IdentifierSet Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.addRaw (String -> Text
    Data.Text.pack String
    modName1)) IdentifierSet
    seen

      let topNm :: Identifier
    topNm = VarEnv Identifier -> Id -> Identifier
    forall a b. HasCallStack => VarEnv a -> Var b -> a
    lookupVarEnv' VarEnv Identifier
    compNames Id
    topEntity
          (String
    modNameS, (String -> Text) -> Maybe String -> 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 String -> Text
    Data.Text.pack -> Maybe Text
    prefixM) = HDL
    -> Maybe Text
    -> Maybe TopEntity
    -> String
    -> (String, Maybe String)
    prefixModuleName (backend -> HDL
    forall state. Backend state => state -> HDL
    hdlKind (backend
    forall a. HasCallStack => a
    undefined :: backend)) (ClashOpts -> Maybe Text
    opt_componentPrefix ClashOpts
    opts) Maybe TopEntity
    annM String
    modName1
          modNameT :: Text
    modNameT  = String -> Text
    Data.Text.pack String
    modNameS
          hdlState' :: backend
    hdlState' = DomainMap -> backend -> backend
    forall state. Backend state => DomainMap -> state -> state
    setDomainConfigurations DomainMap
    domainConfs
                    (backend -> backend) -> backend -> backend
    forall a b. (a -> b) -> a -> b
    $ Text -> backend -> backend
    forall state. Backend state => Text -> state -> state
    setModName Text
    modNameT
                    (backend -> backend) -> backend -> backend
    forall a b. (a -> b) -> a -> b
    $ Identifier -> backend -> backend
    forall state. Backend state => Identifier -> state -> state
    setTopName Identifier
    topNm
                    (backend -> backend) -> backend -> backend
    forall a b. (a -> b) -> a -> b
    $ backend -> Maybe backend -> backend
    forall a. a -> Maybe a -> a
    fromMaybe (forall state. Backend state => ClashOpts -> state
    initBackend @backend ClashOpts
    opts) Maybe backend
    hdlState
          hdlDir :: String
    hdlDir    = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe (backend -> String
    forall state. Backend state => state -> String
    Clash.Backend.name backend
    hdlState') (ClashOpts -> Maybe String
    opt_hdlDir ClashOpts
    opts) String -> String -> String
    </> String
    topEntityS
          manPath :: String
    manPath   = String
    hdlDir String -> String -> String
    </> String
    forall a. IsString a => a
    manifestFilename
          ite :: Bool
    ite       = backend -> Bool
    forall state. Backend state => state -> Bool
    ifThenElseExpr backend
    hdlState'
          topNmT :: Text
    topNmT    = Identifier -> Text
    Id.toText Identifier
    topNm

      -- Get manifest file if cache is not stale and caching is enabled. This is used
      -- to prevent unnecessary recompilation.
      UTCTime
    clashModDate <- IO UTCTime
    getClashModificationDate
      (Maybe [UnexpectedModification]
    userModifications, Maybe Manifest
    maybeManifest, ByteString
    topHash) <-
        [TopEntityT]
    -> (BindingMap, Id)
    -> CompiledPrimMap
    -> ClashOpts
    -> UTCTime
    -> String
    -> IO (Maybe [UnexpectedModification], Maybe Manifest, ByteString)
    readFreshManifest [TopEntityT]
    topEntities0 (BindingMap
    bindingsMap, Id
    topEntity) CompiledPrimMap
    primMap ClashOpts
    opts UTCTime
    clashModDate String
    manPath

      let topEntityNames :: [Id]
    topEntityNames = (TopEntityT -> Id) -> [TopEntityT] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map TopEntityT -> Id
    topId (VarEnv TopEntityT -> [TopEntityT]
    forall a. VarEnv a -> [a]
    eltsVarEnv VarEnv TopEntityT
    topEntityMap)

      case Maybe Manifest
    maybeManifest of
        Just manifest0 :: Manifest
    manifest0@Manifest{[(String, ByteString)]
    fileNames :: [(String, ByteString)]
    fileNames :: Manifest -> [(String, ByteString)]
    fileNames} | Just [] <- Maybe [UnexpectedModification]
    userModifications -> do
          -- Found a 'manifest' files. Use it to extend "seen" set. Generate EDAM
          -- files if necessary.
          MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    ioLockV ((() -> IO ()) -> IO ())
    -> (IO () -> () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    putStrLn (String
    "Clash: Using cached result for: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    topEntityS)

          MVar IdentifierSet -> (IdentifierSet -> IO IdentifierSet) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar IdentifierSet
    seenV ((IdentifierSet -> IO IdentifierSet) -> IO ())
    -> (IdentifierSet -> IO IdentifierSet) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IdentifierSet
    seen ->
            IdentifierSet -> IO IdentifierSet
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (IdentifierSet -> IO IdentifierSet)
    -> IdentifierSet -> IO IdentifierSet
    forall a b. (a -> b) -> a -> b
    $! State IdentifierSet () -> IdentifierSet -> IdentifierSet
    forall s a. State s a -> s -> s
    State.execState ((Text -> State IdentifierSet Identifier)
    -> [Text] -> State IdentifierSet ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Text -> State IdentifierSet Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.addRaw (Manifest -> [Text]
    componentNames Manifest
    manifest0)) IdentifierSet
    seen

          [(String, ByteString)]
    fileNames1 <- MVar (HashMap Unique [EdamFile])
    -> (HashMap Unique [EdamFile]
        -> IO (HashMap Unique [EdamFile], [(String, ByteString)]))
    -> IO [(String, ByteString)]
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (HashMap Unique [EdamFile])
    edamFilesV ((HashMap Unique [EdamFile]
      -> IO (HashMap Unique [EdamFile], [(String, ByteString)]))
     -> IO [(String, ByteString)])
    -> (HashMap Unique [EdamFile]
        -> IO (HashMap Unique [EdamFile], [(String, ByteString)]))
    -> IO [(String, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ \HashMap Unique [EdamFile]
    edamFiles ->
            if ClashOpts -> Bool
    opt_edalize ClashOpts
    opts
              then String
    -> (Identifier, Unique)
    -> HashMap Unique [Unique]
    -> HashMap Unique [EdamFile]
    -> [(String, ByteString)]
    -> IO (HashMap Unique [EdamFile], [(String, ByteString)])
    writeEdam String
    hdlDir (Identifier
    topNm, Id -> Unique
    forall a. Var a -> Unique
    varUniq Id
    topEntity) HashMap Unique [Unique]
    deps HashMap Unique [EdamFile]
    edamFiles [(String, ByteString)]
    fileNames
              else (HashMap Unique [EdamFile], [(String, ByteString)])
    -> IO (HashMap Unique [EdamFile], [(String, ByteString)])
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HashMap Unique [EdamFile]
    edamFiles, [(String, ByteString)]
    fileNames)

          -- If we are generating (System)Verilog, we could potentially verilate
          -- the results. Clash can output a C++ shim for doing this automatically.
          [(String, ByteString)]
    fileNames2 <-
            case Proxy backend -> HDL
    forall backend. Backend backend => Proxy backend -> HDL
    hdlFromBackend (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @backend) of
              HDL
    VHDL -> [(String, ByteString)] -> IO [(String, ByteString)]
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [(String, ByteString)]
    fileNames1
              HDL
    _ -> String
    -> Identifier
    -> [(String, ByteString)]
    -> IO [(String, ByteString)]
    writeVerilatorShim String
    hdlDir Identifier
    topNm [(String, ByteString)]
    fileNames1

          String -> Manifest -> IO ()
    writeManifest String
    manPath Manifest
    manifest0{fileNames=fileNames2}

          UTCTime
    topTime <- IO UTCTime
    Clock.getCurrentTime
          let topDiff :: String
    topDiff = UTCTime -> UTCTime -> String
    reportTimeDiff UTCTime
    topTime UTCTime
    prevTime

          MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    ioLockV ((() -> IO ()) -> IO ())
    -> (IO () -> () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    putStrLn (String
    "Clash: Compiling " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    topEntityS String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " took " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    topDiff)

          () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

        Maybe Manifest
    _ -> do
          -- 1. Prepare HDL directory
          --
          -- [Note] Create HDL dir before netlist generation
          --
          -- Already create the directory where the HDL ends up being generated, as
          -- we use directories relative to this final directory to find manifest
          -- files belonging to other top entities. Failing to do so leads to #463
          String -> ClashOpts -> Maybe [UnexpectedModification] -> IO ()
    prepareDir String
    hdlDir ClashOpts
    opts Maybe [UnexpectedModification]
    userModifications

          -- 2. Normalize topEntity
          Supply
    supplyN <- IO Supply
    Supply.newSupply
          BindingMap
    transformedBindings <- ClashEnv
    -> BindingMap
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either String FilteredHWType)))
    -> Evaluator
    -> Evaluator
    -> [Id]
    -> Supply
    -> Id
    -> IO BindingMap
    normalizeEntity ClashEnv
    env BindingMap
    bindingsMap CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either String FilteredHWType))
    typeTrans Evaluator
    peEval
                                   Evaluator
    eval [Id]
    topEntityNames Supply
    supplyN Id
    topEntity

          UTCTime
    normTime <- BindingMap
    transformedBindings BindingMap -> IO UTCTime -> IO UTCTime
    forall a b. NFData a => a -> b -> b
    `deepseq` IO UTCTime
    Clock.getCurrentTime
          let prepNormDiff :: String
    prepNormDiff = UTCTime -> UTCTime -> String
    reportTimeDiff UTCTime
    normTime UTCTime
    prevTime

          MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    ioLockV ((() -> IO ()) -> IO ())
    -> (IO () -> () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    putStrLn (String
    "Clash: Normalization took " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    prepNormDiff)

          -- 3. Generate netlist for topEntity
          (Component
    topComponent, ComponentMap
    netlist) <- MVar IdentifierSet
    -> (IdentifierSet -> IO (IdentifierSet, (Component, ComponentMap)))
    -> IO (Component, ComponentMap)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar IdentifierSet
    seenV ((IdentifierSet -> IO (IdentifierSet, (Component, ComponentMap)))
     -> IO (Component, ComponentMap))
    -> (IdentifierSet -> IO (IdentifierSet, (Component, ComponentMap)))
    -> IO (Component, ComponentMap)
    forall a b. (a -> b) -> a -> b
    $ \IdentifierSet
    seen -> do
            (Component
    topComponent, ComponentMap
    netlist, IdentifierSet
    seen') <-
              -- TODO My word, this has far too many arguments.
              ClashEnv
    -> Bool
    -> BindingMap
    -> VarEnv TopEntityT
    -> VarEnv Identifier
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either String FilteredHWType)))
    -> Bool
    -> SomeBackend
    -> IdentifierSet
    -> String
    -> Maybe Text
    -> Id
    -> IO (Component, ComponentMap, IdentifierSet)
    genNetlist ClashEnv
    env Bool
    isTb BindingMap
    transformedBindings VarEnv TopEntityT
    topEntityMap VarEnv Identifier
    compNames
                CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either String FilteredHWType))
    typeTrans Bool
    ite (backend -> SomeBackend
    forall backend. Backend backend => backend -> SomeBackend
    SomeBackend backend
    hdlState') IdentifierSet
    seen String
    hdlDir Maybe Text
    prefixM Id
    topEntity

            (IdentifierSet, (Component, ComponentMap))
    -> IO (IdentifierSet, (Component, ComponentMap))
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (IdentifierSet
    seen', (Component
    topComponent, ComponentMap
    netlist))

          UTCTime
    netlistTime <- ComponentMap
    netlist ComponentMap -> IO UTCTime -> IO UTCTime
    forall a b. NFData a => a -> b -> b
    `deepseq` IO UTCTime
    Clock.getCurrentTime
          let normNetDiff :: String
    normNetDiff = UTCTime -> UTCTime -> String
    reportTimeDiff UTCTime
    netlistTime UTCTime
    normTime

          MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    ioLockV ((() -> IO ()) -> IO ())
    -> (IO () -> () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    putStrLn (String
    "Clash: Netlist generation took " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    normNetDiff)

          -- 4. Generate topEntity wrapper
          ([(String, Doc)]
    hdlDocs, [(String, String)]
    dfiles, [(String, String)]
    mfiles) <- MVar IdentifierSet
    -> (IdentifierSet
        -> IO ([(String, Doc)], [(String, String)], [(String, String)]))
    -> IO ([(String, Doc)], [(String, String)], [(String, String)])
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar IdentifierSet
    seenV ((IdentifierSet
      -> IO ([(String, Doc)], [(String, String)], [(String, String)]))
     -> IO ([(String, Doc)], [(String, String)], [(String, String)]))
    -> (IdentifierSet
        -> IO ([(String, Doc)], [(String, String)], [(String, String)]))
    -> IO ([(String, Doc)], [(String, String)], [(String, String)])
    forall a b. (a -> b) -> a -> b
    $ \IdentifierSet
    seen ->
            ([(String, Doc)], [(String, String)], [(String, String)])
    -> IO ([(String, Doc)], [(String, String)], [(String, String)])
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (([(String, Doc)], [(String, String)], [(String, String)])
     -> IO ([(String, Doc)], [(String, String)], [(String, String)]))
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    -> IO ([(String, Doc)], [(String, String)], [(String, String)])
    forall a b. (a -> b) -> a -> b
    $! backend
    -> ClashOpts
    -> Text
    -> IdentifierSet
    -> ComponentMap
    -> DomainMap
    -> Component
    -> Text
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    forall backend.
    Backend backend =>
    backend
    -> ClashOpts
    -> Text
    -> IdentifierSet
    -> ComponentMap
    -> DomainMap
    -> Component
    -> Text
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    createHDL backend
    hdlState' ClashOpts
    opts Text
    modNameT IdentifierSet
    seen ComponentMap
    netlist DomainMap
    domainConfs Component
    topComponent Text
    topNmT

          -- TODO: Data files should go into their own directory
          -- FIXME: Files can silently overwrite each other
          [ByteString]
    hdlDocDigests <- ((String, Doc) -> IO ByteString)
    -> [(String, Doc)] -> IO [ByteString]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM (String -> (String, Doc) -> IO ByteString
    writeHDL String
    hdlDir) [(String, Doc)]
    hdlDocs
          [ByteString]
    dataFilesDigests <- [String] -> String -> [(String, String)] -> IO [ByteString]
    copyDataFiles (ClashOpts -> [String]
    opt_importPaths ClashOpts
    opts) String
    hdlDir [(String, String)]
    dfiles
          [ByteString]
    memoryFilesDigests <- String -> [(String, String)] -> IO [ByteString]
    writeMemoryDataFiles String
    hdlDir [(String, String)]
    mfiles

          let
            components :: [Component]
    components = ((Unique, (ComponentMeta, Component)) -> Component)
    -> [(Unique, (ComponentMeta, Component))] -> [Component]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ComponentMeta, Component) -> Component
    forall a b. (a, b) -> b
    snd ((ComponentMeta, Component) -> Component)
    -> ((Unique, (ComponentMeta, Component))
        -> (ComponentMeta, Component))
    -> (Unique, (ComponentMeta, Component))
    -> Component
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unique, (ComponentMeta, Component)) -> (ComponentMeta, Component)
    forall a b. (a, b) -> b
    snd) (ComponentMap -> [(Unique, (ComponentMeta, Component))]
    forall k v. OMap k v -> [(k, v)]
    OMap.assocs ComponentMap
    netlist)
            filesAndDigests0 :: [(String, ByteString)]
    filesAndDigests0 =
              -- FIXME: We should track dependencies of `mfiles` and `dfiles` and
              -- maintain the proper topological sort of all these.
                 [String] -> [ByteString] -> [(String, ByteString)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> a
    fst [(String, String)]
    mfiles) [ByteString]
    memoryFilesDigests
              [(String, ByteString)]
    -> [(String, ByteString)] -> [(String, ByteString)]
    forall a. Semigroup a => a -> a -> a
    <> [String] -> [ByteString] -> [(String, ByteString)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> a
    fst [(String, String)]
    dfiles) [ByteString]
    dataFilesDigests
              [(String, ByteString)]
    -> [(String, ByteString)] -> [(String, ByteString)]
    forall a. Semigroup a => a -> a -> a
    <> [String] -> [ByteString] -> [(String, ByteString)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (((String, Doc) -> String) -> [(String, Doc)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Doc) -> String
    forall a b. (a, b) -> a
    fst [(String, Doc)]
    hdlDocs) [ByteString]
    hdlDocDigests

          [(String, ByteString)]
    filesAndDigests1 <- MVar (HashMap Unique [EdamFile])
    -> (HashMap Unique [EdamFile]
        -> IO (HashMap Unique [EdamFile], [(String, ByteString)]))
    -> IO [(String, ByteString)]
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (HashMap Unique [EdamFile])
    edamFilesV ((HashMap Unique [EdamFile]
      -> IO (HashMap Unique [EdamFile], [(String, ByteString)]))
     -> IO [(String, ByteString)])
    -> (HashMap Unique [EdamFile]
        -> IO (HashMap Unique [EdamFile], [(String, ByteString)]))
    -> IO [(String, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ \HashMap Unique [EdamFile]
    edamFiles ->
            if ClashOpts -> Bool
    opt_edalize ClashOpts
    opts
              then String
    -> (Identifier, Unique)
    -> HashMap Unique [Unique]
    -> HashMap Unique [EdamFile]
    -> [(String, ByteString)]
    -> IO (HashMap Unique [EdamFile], [(String, ByteString)])
    writeEdam String
    hdlDir (Identifier
    topNm, Id -> Unique
    forall a. Var a -> Unique
    varUniq Id
    topEntity) HashMap Unique [Unique]
    deps HashMap Unique [EdamFile]
    edamFiles [(String, ByteString)]
    filesAndDigests0
              else (HashMap Unique [EdamFile], [(String, ByteString)])
    -> IO (HashMap Unique [EdamFile], [(String, ByteString)])
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HashMap Unique [EdamFile]
    edamFiles, [(String, ByteString)]
    filesAndDigests0)

          [(String, ByteString)]
    filesAndDigests2 <-
            case Proxy backend -> HDL
    forall backend. Backend backend => Proxy backend -> HDL
    hdlFromBackend (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @backend) of
              HDL
    VHDL -> [(String, ByteString)] -> IO [(String, ByteString)]
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [(String, ByteString)]
    filesAndDigests1
              HDL
    _ -> String
    -> Identifier
    -> [(String, ByteString)]
    -> IO [(String, ByteString)]
    writeVerilatorShim String
    hdlDir Identifier
    topNm [(String, ByteString)]
    filesAndDigests1

          let
            depUniques :: [Unique]
    depUniques = [Unique] -> Maybe [Unique] -> [Unique]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Unique -> HashMap Unique [Unique] -> Maybe [Unique]
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMap.lookup (Id -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique Id
    topEntity) HashMap Unique [Unique]
    deps)
            depBindings :: [Binding Term]
    depBindings = (Unique -> Maybe (Binding Term)) -> [Unique] -> [Binding Term]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((Unique -> BindingMap -> Maybe (Binding Term))
    -> BindingMap -> Unique -> Maybe (Binding Term)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Unique -> BindingMap -> Maybe (Binding Term)
    forall a. Unique -> VarEnv a -> Maybe a
    lookupVarEnvDirectly BindingMap
    bindingsMap) [Unique]
    depUniques
            depIds :: [Id]
    depIds = (Binding Term -> Id) -> [Binding Term] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map Binding Term -> Id
    forall a. Binding a -> Id
    bindingId [Binding Term]
    depBindings

            manifest :: Manifest
    manifest =
              backend
    -> DomainMap
    -> ClashOpts
    -> Component
    -> [Component]
    -> [Id]
    -> [(String, ByteString)]
    -> ByteString
    -> Manifest
    forall backend.
    Backend backend =>
    backend
    -> DomainMap
    -> ClashOpts
    -> Component
    -> [Component]
    -> [Id]
    -> [(String, ByteString)]
    -> ByteString
    -> Manifest
    mkManifest
                backend
    hdlState' DomainMap
    domainConfs ClashOpts
    opts Component
    topComponent [Component]
    components [Id]
    depIds
                [(String, ByteString)]
    filesAndDigests2 ByteString
    topHash
          String -> Manifest -> IO ()
    writeManifest String
    manPath Manifest
    manifest

          UTCTime
    topTime <- [(String, Doc)]
    hdlDocs [(String, Doc)] -> IO UTCTime -> IO UTCTime
    forall a b. a -> b -> b
    `seq` IO UTCTime
    Clock.getCurrentTime
          let topDiff :: String
    topDiff = UTCTime -> UTCTime -> String
    reportTimeDiff UTCTime
    topTime UTCTime
    prevTime

          MVar () -> (() -> IO ()) -> IO ()
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    ioLockV ((() -> IO ()) -> IO ())
    -> (IO () -> () -> IO ()) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    putStrLn (String
    "Clash: Compiling " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    topEntityS String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " took " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    topDiff)

    -- | Interpret a specific function from a specific module. This action tries
    -- two things:
    --
    --   1. Interpret without explicitly loading the module. This will succeed if
    --      the module was already loaded through a package database (set using
    --      'interpreterArgs').
    --
    --   2. If (1) fails, it does try to load it explicitly. If this also fails,
    --      an error is returned.
    --
    loadImportAndInterpret
      :: (MonadIO m, MonadMask m)
      => [String]
      -- ^ Extra search path (usually passed as -i)
      -> [String]
      -- ^ Interpreter args
      -> String
      -- ^ The folder in which the GHC bootstrap libraries (base, containers, etc.)
      -- can be found
      -> Hint.ModuleName
      -- ^ Module function lives in
      -> String
      -- ^ Function name
      -> String
      -- ^ Type name ('BlackBoxFunction' or 'TemplateFunction')
      -> m (Either Hint.InterpreterError a)
    loadImportAndInterpret :: forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> m (Either InterpreterError a)
    loadImportAndInterpret [String]
    iPaths0 [String]
    interpreterArgs String
    topDir String
    qualMod String
    funcName String
    typ = do
      IO () -> m ()
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    Hint.liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    Monad.when Bool
    debugIsOn (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        String -> IO ()
    putStr String
    "Hint: Interpreting " IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    putStrLn (String
    qualMod String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    funcName)
      -- Try to interpret function *without* loading module explicitly. If this
      -- succeeds, the module was already in the global package database(s).
      Either InterpreterError a
    bbfE <- [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    Hint.unsafeRunInterpreterWithArgsLibdir [String]
    interpreterArgs String
    topDir (InterpreterT m a -> m (Either InterpreterError a))
    -> InterpreterT m a -> m (Either InterpreterError a)
    forall a b. (a -> b) -> a -> b
    $ do
        [String]
    iPaths1 <- ([String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++[String]
    iPaths0) ([String] -> [String])
    -> InterpreterT m [String] -> InterpreterT m [String]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Option (InterpreterT m) [String] -> InterpreterT m [String]
    forall (m :: Type -> Type) a.
    MonadInterpreter m =>
    Option m a -> m a
    Hint.get Option (InterpreterT m) [String]
    forall (m :: Type -> Type). MonadInterpreter m => Option m [String]
    Hint.searchPath
        [OptionVal (InterpreterT m)] -> InterpreterT m ()
    forall (m :: Type -> Type).
    MonadInterpreter m =>
    [OptionVal m] -> m ()
    Hint.set [Option (InterpreterT m) [String]
    forall (m :: Type -> Type). MonadInterpreter m => Option m [String]
    Hint.searchPath Option (InterpreterT m) [String]
    -> [String] -> OptionVal (InterpreterT m)
    forall (m :: Type -> Type) a. Option m a -> a -> OptionVal m
    Hint.:= [String]
    iPaths1]
        [String] -> InterpreterT m ()
    forall (m :: Type -> Type). MonadInterpreter m => [String] -> m ()
    Hint.setImports [ String
    "Clash.Netlist.Types", String
    "Clash.Netlist.BlackBox.Types", String
    qualMod]
        String -> String -> InterpreterT m a
    forall (m :: Type -> Type) a.
    MonadInterpreter m =>
    String -> String -> m a
    Hint.unsafeInterpret String
    funcName String
    typ

      case Either InterpreterError a
    bbfE of
        Left InterpreterError
    _ -> do
          -- Try to interpret module as a local module, not yet present in the
          -- global package database(s).
          [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    Hint.unsafeRunInterpreterWithArgsLibdir [String]
    interpreterArgs String
    topDir (InterpreterT m a -> m (Either InterpreterError a))
    -> InterpreterT m a -> m (Either InterpreterError a)
    forall a b. (a -> b) -> a -> b
    $ do
            InterpreterT m ()
    forall (m :: Type -> Type). MonadInterpreter m => m ()
    Hint.reset
            [String]
    iPaths1 <- ([String]
    iPaths0++) ([String] -> [String])
    -> InterpreterT m [String] -> InterpreterT m [String]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Option (InterpreterT m) [String] -> InterpreterT m [String]
    forall (m :: Type -> Type) a.
    MonadInterpreter m =>
    Option m a -> m a
    Hint.get Option (InterpreterT m) [String]
    forall (m :: Type -> Type). MonadInterpreter m => Option m [String]
    Hint.searchPath
            [OptionVal (InterpreterT m)] -> InterpreterT m ()
    forall (m :: Type -> Type).
    MonadInterpreter m =>
    [OptionVal m] -> m ()
    Hint.set [ Option (InterpreterT m) [String]
    forall (m :: Type -> Type). MonadInterpreter m => Option m [String]
    Hint.searchPath Option (InterpreterT m) [String]
    -> [String] -> OptionVal (InterpreterT m)
    forall (m :: Type -> Type) a. Option m a -> a -> OptionVal m
    Hint.:= [String]
    iPaths1
                     , Option (InterpreterT m) [Extension]
    forall (m :: Type -> Type).
    MonadInterpreter m =>
    Option m [Extension]
    Hint.languageExtensions Option (InterpreterT m) [Extension]
    -> [Extension] -> OptionVal (InterpreterT m)
    forall (m :: Type -> Type) a. Option m a -> a -> OptionVal m
    Hint.:= [Extension]
    langExts]
            [String] -> InterpreterT m ()
    forall (m :: Type -> Type). MonadInterpreter m => [String] -> m ()
    Hint.loadModules [String
    qualMod]
            [String] -> InterpreterT m ()
    forall (m :: Type -> Type). MonadInterpreter m => [String] -> m ()
    Hint.setImports [ String
    "Clash.Netlist.BlackBox.Types", String
    "Clash.Netlist.Types", String
    qualMod]
            String -> String -> InterpreterT m a
    forall (m :: Type -> Type) a.
    MonadInterpreter m =>
    String -> String -> m a
    Hint.unsafeInterpret String
    funcName String
    typ
        Right a
    _ -> do
          Either InterpreterError a -> m (Either InterpreterError a)
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Either InterpreterError a
    bbfE
     where
       langExts :: [Extension]
    langExts = (String -> Extension) -> [String] -> [Extension]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Extension
    Hint.asExtension ([String] -> [Extension]) -> [String] -> [Extension]
    forall a b. (a -> b) -> a -> b
    $
                    (Extension -> String) -> [Extension] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Extension -> String
    forall a. Show a => a -> String
    show [Extension]
    wantedLanguageExtensions [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                    (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "No" ++ ) ((Extension -> String) -> [Extension] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Extension -> String
    forall a. Show a => a -> String
    show [Extension]
    unwantedLanguageExtensions)

    -- | List of known BlackBoxFunctions used to prevent Hint from firing. This
    --  improves Clash startup times.
    knownBlackBoxFunctions :: HashMap String BlackBoxFunction
    knownBlackBoxFunctions :: HashMap String BlackBoxFunction
    knownBlackBoxFunctions =
      [(String, BlackBoxFunction)] -> HashMap String BlackBoxFunction
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ([(String, BlackBoxFunction)] -> HashMap String BlackBoxFunction)
    -> [(String, BlackBoxFunction)] -> HashMap String BlackBoxFunction
    forall a b. (a -> b) -> a -> b
    $ ((Name, BlackBoxFunction) -> (String, BlackBoxFunction))
    -> [(Name, BlackBoxFunction)] -> [(String, BlackBoxFunction)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> String)
    -> (Name, BlackBoxFunction) -> (String, BlackBoxFunction)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: Type -> Type -> Type) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Name -> String
    forall a. Show a => a -> String
    show) ([(Name, BlackBoxFunction)] -> [(String, BlackBoxFunction)])
    -> [(Name, BlackBoxFunction)] -> [(String, BlackBoxFunction)]
    forall a b. (a -> b) -> a -> b
    $
        [ ('P.checkBBF, BlackBoxFunction
    P.checkBBF)
        , ('P.bvToIntegerVHDL, BlackBoxFunction
    P.bvToIntegerVHDL)
        , ('P.bvToIntegerVerilog, BlackBoxFunction
    P.bvToIntegerVerilog)
        , ('P.clashCompileErrorBBF, HasCallStack => BlackBoxFunction
    BlackBoxFunction
    P.clashCompileErrorBBF)
        , ('P.foldBBF, HasCallStack => BlackBoxFunction
    BlackBoxFunction
    P.foldBBF)
        , ('P.indexIntVerilog, BlackBoxFunction
    P.indexIntVerilog)
        , ('P.indexToIntegerVerilog, BlackBoxFunction
    P.indexToIntegerVerilog)
        , ('P.indexToIntegerVHDL, BlackBoxFunction
    P.indexToIntegerVHDL)
        , ('P.intTF, BlackBoxFunction
    P.intTF)
        , ('P.iterateBBF, HasCallStack => BlackBoxFunction
    BlackBoxFunction
    P.iterateBBF)
        , ('P.signedToIntegerVerilog, BlackBoxFunction
    P.signedToIntegerVerilog)
        , ('P.signedToIntegerVHDL, BlackBoxFunction
    P.signedToIntegerVHDL)
        , ('P.unsignedToIntegerVerilog, BlackBoxFunction
    P.unsignedToIntegerVerilog)
        , ('P.unsignedToIntegerVHDL, BlackBoxFunction
    P.unsignedToIntegerVHDL)
        , ('P.wordTF, BlackBoxFunction
    P.wordTF)
        ]

    -- | List of known TemplateFunctions used to prevent Hint from firing. This
    --  improves Clash startup times.
    knownTemplateFunctions :: HashMap String TemplateFunction
    knownTemplateFunctions :: HashMap String TemplateFunction
    knownTemplateFunctions =
      [(String, TemplateFunction)] -> HashMap String TemplateFunction
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ([(String, TemplateFunction)] -> HashMap String TemplateFunction)
    -> [(String, TemplateFunction)] -> HashMap String TemplateFunction
    forall a b. (a -> b) -> a -> b
    $ ((Name, TemplateFunction) -> (String, TemplateFunction))
    -> [(Name, TemplateFunction)] -> [(String, TemplateFunction)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> String)
    -> (Name, TemplateFunction) -> (String, TemplateFunction)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: Type -> Type -> Type) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Name -> String
    forall a. Show a => a -> String
    show) ([(Name, TemplateFunction)] -> [(String, TemplateFunction)])
    -> [(Name, TemplateFunction)] -> [(String, TemplateFunction)]
    forall a b. (a -> b) -> a -> b
    $
        [ ('P.altpllQsysTF, TemplateFunction
    P.altpllQsysTF)
        , ('P.alteraPllQsysTF, TemplateFunction
    P.alteraPllQsysTF)
        , ('P.alteraPllTF, TemplateFunction
    P.alteraPllTF)
        , ('P.altpllTF, TemplateFunction
    P.altpllTF)
        , ('P.fromIntegerTFvhdl, TemplateFunction
    P.fromIntegerTFvhdl)
        , ('P.clockWizardTF, TemplateFunction
    P.clockWizardTF)
        , ('P.clockWizardDifferentialTF, TemplateFunction
    P.clockWizardDifferentialTF)
        , ('P.clockWizardTclTF, TemplateFunction
    P.clockWizardTclTF)
        , ('P.clockWizardDifferentialTclTF, TemplateFunction
    P.clockWizardDifferentialTclTF)
        ]

    -- | Compiles blackbox functions and parses blackbox templates.
    compilePrimitive
      :: [FilePath]
      -- ^ Import directories (-i flag)
      -> [FilePath]
      -- ^ Package databases
      -> FilePath
      -- ^ The folder in which the GHC bootstrap libraries (base, containers, etc.)
      -- can be found
      -> ResolvedPrimitive
      -- ^ Primitive to compile
      -> IO CompiledPrimitive
    compilePrimitive :: [String]
    -> [String] -> String -> ResolvedPrimitive -> IO CompiledPrimitive
    compilePrimitive [String]
    idirs [String]
    pkgDbs String
    topDir (BlackBoxHaskell Text
    bbName WorkInfo
    wf UsedArguments
    usedArgs Bool
    multiRes BlackBoxFunctionName
    bbGenName Maybe Text
    source) = do
      BlackBoxFunction
    bbFunc <-
        -- TODO: Use cache for hint targets. Right now Hint will fire multiple times
        -- TODO: if multiple functions use the same blackbox haskell function.
        case String -> HashMap String BlackBoxFunction -> Maybe BlackBoxFunction
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMap.lookup String
    fullName HashMap String BlackBoxFunction
    knownBlackBoxFunctions of
          Just BlackBoxFunction
    f -> BlackBoxFunction -> IO BlackBoxFunction
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure BlackBoxFunction
    f
          Maybe BlackBoxFunction
    Nothing -> do
            Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    Monad.when Bool
    debugIsOn (String -> IO ()
    putStr String
    "Hint: interpreting " IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    putStrLn (String -> String
    forall a. Show a => a -> String
    show String
    fullName))
            let interpreterArgs :: [String]
    interpreterArgs = (String -> [String]) -> [String] -> [String]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap ((String
    "-package-db":) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[])) [String]
    pkgDbs
            -- Compile a blackbox template function or fetch it from an already compiled file.
            Either InterpreterError BlackBoxFunction
    r <- [String]
    -> Maybe Text -> IO (Either InterpreterError BlackBoxFunction)
    go [String]
    interpreterArgs Maybe Text
    source
            String
    -> Text
    -> (BlackBoxFunction -> BlackBoxFunction)
    -> Either InterpreterError BlackBoxFunction
    -> IO BlackBoxFunction
    forall (m :: Type -> Type) t r.
    Monad m =>
    String -> Text -> (t -> r) -> Either InterpreterError t -> m r
    processHintError
              (BlackBoxFunctionName -> String
    forall a. Show a => a -> String
    show BlackBoxFunctionName
    bbGenName)
              Text
    bbName
              BlackBoxFunction -> BlackBoxFunction
    forall a. a -> a
    id
              Either InterpreterError BlackBoxFunction
    r

      CompiledPrimitive -> IO CompiledPrimitive
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Text
    -> WorkInfo
    -> UsedArguments
    -> Bool
    -> BlackBoxFunctionName
    -> (Unique, BlackBoxFunction)
    -> CompiledPrimitive
    forall a b c d.
    Text
    -> WorkInfo
    -> UsedArguments
    -> Bool
    -> BlackBoxFunctionName
    -> d
    -> Primitive a b c d
    BlackBoxHaskell Text
    bbName WorkInfo
    wf UsedArguments
    usedArgs Bool
    multiRes BlackBoxFunctionName
    bbGenName (Maybe Text -> Unique
    forall a. Hashable a => a -> Unique
    hash Maybe Text
    source, BlackBoxFunction
    bbFunc))
     where
        fullName :: String
    fullName = String
    qualMod String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    funcName
        qualMod :: String
    qualMod = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." [String]
    modNames
        BlackBoxFunctionName [String]
    modNames String
    funcName = BlackBoxFunctionName
    bbGenName

        -- | Create directory based on base name and directory. Return path
        -- of directory just created.
        createDirectory'
          :: FilePath
          -> FilePath
          -> IO FilePath
        createDirectory' :: String -> String -> IO String
    createDirectory' String
    base String
    sub =
          let new :: String
    new = String
    base String -> String -> String
    </> String
    sub in
          String -> IO ()
    Directory.createDirectory String
    new IO () -> IO String -> IO String
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> String -> IO String
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return String
    new

        go
          :: [String]
          -> Maybe Text
          -> IO (Either Hint.InterpreterError BlackBoxFunction)
        go :: [String]
    -> Maybe Text -> IO (Either InterpreterError BlackBoxFunction)
    go [String]
    args (Just Text
    source') = do
          -- Create a temporary directory with user module in it, add it to the
          -- list of import direcotries, and run as if it were a "normal" compiled
          -- module.
          String
    tmpDir0 <- IO String
    getCanonicalTemporaryDirectory
          String
    -> String
    -> (String -> IO (Either InterpreterError BlackBoxFunction))
    -> IO (Either InterpreterError BlackBoxFunction)
    forall (m :: Type -> Type) a.
    (MonadMask m, MonadIO m) =>
    String -> String -> (String -> m a) -> m a
    withTempDirectory String
    tmpDir0 String
    "clash-prim-compile" ((String -> IO (Either InterpreterError BlackBoxFunction))
     -> IO (Either InterpreterError BlackBoxFunction))
    -> (String -> IO (Either InterpreterError BlackBoxFunction))
    -> IO (Either InterpreterError BlackBoxFunction)
    forall a b. (a -> b) -> a -> b
    $ \String
    tmpDir1 -> do
            String
    modDir <- (String -> String -> IO String) -> String -> [String] -> IO String
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM String -> String -> IO String
    createDirectory' String
    tmpDir1 ([String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    init [String]
    modNames)
            String -> Text -> IO ()
    Text.writeFile (String
    modDir String -> String -> String
    </> ([String] -> String
    forall a. HasCallStack => [a] -> a
    last [String]
    modNames String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".hs")) Text
    source'
            [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> IO (Either InterpreterError BlackBoxFunction)
    forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> m (Either InterpreterError a)
    loadImportAndInterpret (String
    tmpDir1String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    idirs) [String]
    args String
    topDir String
    qualMod String
    funcName String
    "BlackBoxFunction"

        go [String]
    args Maybe Text
    Nothing = do
          [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> IO (Either InterpreterError BlackBoxFunction)
    forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> m (Either InterpreterError a)
    loadImportAndInterpret [String]
    idirs [String]
    args String
    topDir String
    qualMod String
    funcName String
    "BlackBoxFunction"

    compilePrimitive [String]
    idirs [String]
    pkgDbs String
    topDir
      (BlackBox Text
    pNm WorkInfo
    wf RenderVoid
    rVoid Bool
    multiRes TemplateKind
    tkind () Usage
    outputUsage [Text]
    libM [Text]
    imps [(Unique, Unique)]
    fPlural [((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
    incs [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    rM [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    riM ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    templ) = do
      [BlackBoxTemplate]
    libM'  <- (Text -> IO BlackBoxTemplate) -> [Text] -> IO [BlackBoxTemplate]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM Text -> IO BlackBoxTemplate
    forall (m :: Type -> Type).
    Applicative m =>
    Text -> m BlackBoxTemplate
    parseTempl [Text]
    libM
      [BlackBoxTemplate]
    imps'  <- (Text -> IO BlackBoxTemplate) -> [Text] -> IO [BlackBoxTemplate]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM Text -> IO BlackBoxTemplate
    forall (m :: Type -> Type).
    Applicative m =>
    Text -> m BlackBoxTemplate
    parseTempl [Text]
    imps
      [((Text, Text), BlackBox)]
    incs'  <- (((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe Text))
     -> IO ((Text, Text), BlackBox))
    -> [((Text, Text),
         ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
    -> IO [((Text, Text), BlackBox)]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM ((((TemplateFormat, BlackBoxFunctionName), Maybe Text)
     -> IO BlackBox)
    -> ((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe Text))
    -> IO ((Text, Text), BlackBox)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> ((Text, Text), a) -> f ((Text, Text), b)
    traverse ((TemplateFormat, BlackBoxFunctionName), Maybe Text) -> IO BlackBox
    parseBB) [((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
    incs
      BlackBox
    templ' <- ((TemplateFormat, BlackBoxFunctionName), Maybe Text) -> IO BlackBox
    parseBB ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    templ
      [BlackBox]
    rM'    <- (((TemplateFormat, BlackBoxFunctionName), Maybe Text)
     -> IO BlackBox)
    -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    -> IO [BlackBox]
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((TemplateFormat, BlackBoxFunctionName), Maybe Text) -> IO BlackBox
    parseBB [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    rM
      [BlackBox]
    riM'   <- (((TemplateFormat, BlackBoxFunctionName), Maybe Text)
     -> IO BlackBox)
    -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    -> IO [BlackBox]
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((TemplateFormat, BlackBoxFunctionName), Maybe Text) -> IO BlackBox
    parseBB [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    riM
      CompiledPrimitive -> IO CompiledPrimitive
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Text
    -> WorkInfo
    -> RenderVoid
    -> Bool
    -> TemplateKind
    -> ()
    -> Usage
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [(Unique, Unique)]
    -> [((Text, Text), BlackBox)]
    -> [BlackBox]
    -> [BlackBox]
    -> BlackBox
    -> CompiledPrimitive
    forall a b c d.
    Text
    -> WorkInfo
    -> RenderVoid
    -> Bool
    -> TemplateKind
    -> c
    -> Usage
    -> [a]
    -> [a]
    -> [(Unique, Unique)]
    -> [((Text, Text), b)]
    -> [b]
    -> [b]
    -> b
    -> Primitive a b c d
    BlackBox Text
    pNm WorkInfo
    wf RenderVoid
    rVoid Bool
    multiRes TemplateKind
    tkind () Usage
    outputUsage [BlackBoxTemplate]
    libM' [BlackBoxTemplate]
    imps' [(Unique, Unique)]
    fPlural [((Text, Text), BlackBox)]
    incs' [BlackBox]
    rM' [BlackBox]
    riM' BlackBox
    templ')
     where
      iArgs :: [String]
    iArgs = (String -> [String]) -> [String] -> [String]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap ((String
    "-package-db":) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[])) [String]
    pkgDbs

      parseTempl
        :: Applicative m
        => Text
        -> m BlackBoxTemplate
      parseTempl :: forall (m :: Type -> Type).
    Applicative m =>
    Text -> m BlackBoxTemplate
    parseTempl Text
    t = case Text -> Result BlackBoxTemplate
    runParse Text
    t of
        Failure ErrInfo
    errInfo
          -> String -> m BlackBoxTemplate
    forall a. HasCallStack => String -> a
    error (String
    "Parsing template for blackbox " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    Data.Text.unpack Text
    pNm String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " failed:\n"
                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc AnsiStyle -> String
    forall a. Show a => a -> String
    show (ErrInfo -> Doc AnsiStyle
    _errDoc ErrInfo
    errInfo))
        Success BlackBoxTemplate
    t'
          -> BlackBoxTemplate -> m BlackBoxTemplate
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure BlackBoxTemplate
    t'

      parseBB
        :: ((TemplateFormat,BlackBoxFunctionName), Maybe Text)
        -> IO BlackBox
      parseBB :: ((TemplateFormat, BlackBoxFunctionName), Maybe Text) -> IO BlackBox
    parseBB ((TemplateFormat
    TTemplate,BlackBoxFunctionName
    _),Just Text
    t)     = BlackBoxTemplate -> BlackBox
    BBTemplate (BlackBoxTemplate -> BlackBox)
    -> IO BlackBoxTemplate -> IO BlackBox
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> IO BlackBoxTemplate
    forall (m :: Type -> Type).
    Applicative m =>
    Text -> m BlackBoxTemplate
    parseTempl Text
    t
      parseBB ((TemplateFormat
    TTemplate,BlackBoxFunctionName
    _),Maybe Text
    Nothing)    =
        String -> IO BlackBox
    forall a. HasCallStack => String -> a
    error (String
    "No template specified for blackbox: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    pNm)
      parseBB ((TemplateFormat
    THaskell,BlackBoxFunctionName
    bbGenName),Just Text
    source) = do
        let BlackBoxFunctionName [String]
    modNames String
    funcName = BlackBoxFunctionName
    bbGenName
            qualMod :: String
    qualMod = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." [String]
    modNames
        String
    tmpDir <- IO String
    getCanonicalTemporaryDirectory
        Either InterpreterError TemplateFunction
    r <- String
    -> String
    -> (String -> IO (Either InterpreterError TemplateFunction))
    -> IO (Either InterpreterError TemplateFunction)
    forall (m :: Type -> Type) a.
    (MonadMask m, MonadIO m) =>
    String -> String -> (String -> m a) -> m a
    withTempDirectory String
    tmpDir String
    "clash-prim-compile" ((String -> IO (Either InterpreterError TemplateFunction))
     -> IO (Either InterpreterError TemplateFunction))
    -> (String -> IO (Either InterpreterError TemplateFunction))
    -> IO (Either InterpreterError TemplateFunction)
    forall a b. (a -> b) -> a -> b
    $ \String
    tmpDir' -> do
          let modDir :: String
    modDir = (String -> String -> String) -> String -> [String] -> String
    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 String -> String -> String
    (</>) String
    tmpDir' ([String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    init [String]
    modNames)
          Bool -> String -> IO ()
    Directory.createDirectoryIfMissing Bool
    True String
    modDir
          String -> Text -> IO ()
    Text.writeFile (String
    modDir String -> String -> String
    </> [String] -> String
    forall a. HasCallStack => [a] -> a
    last [String]
    modNames String -> String -> String
    <.>  String
    "hs") Text
    source
          [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> IO (Either InterpreterError TemplateFunction)
    forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> m (Either InterpreterError a)
    loadImportAndInterpret (String
    tmpDir'String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    idirs) [String]
    iArgs String
    topDir String
    qualMod String
    funcName String
    "TemplateFunction"
        let hsh :: Unique
    hsh = (String, Text) -> Unique
    forall a. Hashable a => a -> Unique
    hash (String
    qualMod, Text
    source)
        String
    -> Text
    -> (TemplateFunction -> BlackBox)
    -> Either InterpreterError TemplateFunction
    -> IO BlackBox
    forall (m :: Type -> Type) t r.
    Monad m =>
    String -> Text -> (t -> r) -> Either InterpreterError t -> m r
    processHintError (BlackBoxFunctionName -> String
    forall a. Show a => a -> String
    show BlackBoxFunctionName
    bbGenName) Text
    pNm (String -> Unique -> TemplateFunction -> BlackBox
    BBFunction (Text -> String
    Data.Text.unpack Text
    pNm) Unique
    hsh) Either InterpreterError TemplateFunction
    r
      parseBB ((TemplateFormat
    THaskell,BlackBoxFunctionName
    bbGenName),Maybe Text
    Nothing) = do
        let BlackBoxFunctionName [String]
    modNames String
    funcName = BlackBoxFunctionName
    bbGenName
            qualMod :: String
    qualMod = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." [String]
    modNames
            hsh :: Unique
    hsh     = String -> Unique
    forall a. Hashable a => a -> Unique
    hash String
    qualMod
            fullName :: String
    fullName = String
    qualMod String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    funcName
        TemplateFunction
    tf <-
          case String -> HashMap String TemplateFunction -> Maybe TemplateFunction
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMap.lookup String
    fullName HashMap String TemplateFunction
    knownTemplateFunctions of
            Just TemplateFunction
    f -> TemplateFunction -> IO TemplateFunction
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TemplateFunction
    f
            Maybe TemplateFunction
    Nothing -> do
              Either InterpreterError TemplateFunction
    r <- [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> IO (Either InterpreterError TemplateFunction)
    forall (m :: Type -> Type) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> [String]
    -> String
    -> String
    -> String
    -> String
    -> m (Either InterpreterError a)
    loadImportAndInterpret [String]
    idirs [String]
    iArgs String
    topDir String
    qualMod String
    funcName String
    "TemplateFunction"
              String
    -> Text
    -> (TemplateFunction -> TemplateFunction)
    -> Either InterpreterError TemplateFunction
    -> IO TemplateFunction
    forall (m :: Type -> Type) t r.
    Monad m =>
    String -> Text -> (t -> r) -> Either InterpreterError t -> m r
    processHintError (BlackBoxFunctionName -> String
    forall a. Show a => a -> String
    show BlackBoxFunctionName
    bbGenName) Text
    pNm TemplateFunction -> TemplateFunction
    forall a. a -> a
    id Either InterpreterError TemplateFunction
    r
        BlackBox -> IO BlackBox
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (String -> Unique -> TemplateFunction -> BlackBox
    BBFunction (Text -> String
    Data.Text.unpack Text
    pNm) Unique
    hsh TemplateFunction
    tf)

    compilePrimitive [String]
    _ [String]
    _ String
    _ (Primitive Text
    pNm WorkInfo
    wf Text
    typ) =
      CompiledPrimitive -> IO CompiledPrimitive
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Text -> WorkInfo -> Text -> CompiledPrimitive
    forall a b c d. Text -> WorkInfo -> Text -> Primitive a b c d
    Primitive Text
    pNm WorkInfo
    wf Text
    typ)
    {-# SCC compilePrimitive #-}

    processHintError
      :: Monad m
      => String
      -> Data.Text.Text
      -> (t -> r)
      -> Either Hint.InterpreterError t
      -> m r
    processHintError :: forall (m :: Type -> Type) t r.
    Monad m =>
    String -> Text -> (t -> r) -> Either InterpreterError t -> m r
    processHintError String
    fun Text
    bb t -> r
    go Either InterpreterError t
    r = case Either InterpreterError t
    r of
      Left (Hint.GhcException String
    err) ->
        String -> String -> m r
    forall {a}. String -> String -> a
    error' String
    "GHC Exception" String
    err
      Left (Hint.NotAllowed String
    err) ->
        String -> String -> m r
    forall {a}. String -> String -> a
    error' String
    "NotAllowed error" String
    err
      Left (Hint.UnknownError String
    err) ->
        String -> String -> m r
    forall {a}. String -> String -> a
    error' String
    "an unknown error" String
    err
      Left (Hint.WontCompile [GhcError]
    ghcErrs) ->
        String -> String -> m r
    forall {a}. String -> String -> a
    error' String
    "compilation errors" (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (GhcError -> String) -> [GhcError] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map GhcError -> String
    Hint.errMsg [GhcError]
    ghcErrs)
      Right t
    f ->
        r -> m r
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (r -> m r) -> r -> m r
    forall a b. (a -> b) -> a -> b
    $ t -> r
    go t
    f
     where
      error' :: String -> String -> a
    error' String
    errType String
    report =
        String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [ String
    "Encountered", String
    errType, String
    "while compiling blackbox template"
                        , String
    "function", String -> String
    forall a. Show a => a -> String
    show String
    fun, String
    "for function", Text -> String
    forall a. Show a => a -> String
    show Text
    bb String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "."
                        , String
    "Compilation reported: \n\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    report ]

    -- | Pretty print Components to HDL Documents
    createHDL
      :: Backend backend
      => backend
      -- ^ Backend
      -> ClashOpts
      -- ^ Global Clash options
      -> IdentifierText
      -- ^ Module hierarchy root
      -> Id.IdentifierSet
      -- ^ Component names
      -> ComponentMap
      -- ^ List of components
      -> HashMap Data.Text.Text VDomainConfiguration
      -- ^ Known domains to configurations
      -> Component
      -- ^ Top component
      -> IdentifierText
      -- ^ Name of the manifest file
      -> ([(String,Doc)],[(String,FilePath)],[(String,String)])
      -- ^ The pretty-printed HDL documents
      -- + The data files that need to be copied
    createHDL :: forall backend.
    Backend backend =>
    backend
    -> ClashOpts
    -> Text
    -> IdentifierSet
    -> ComponentMap
    -> DomainMap
    -> Component
    -> Text
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    createHDL backend
    backend ClashOpts
    opts Text
    modName IdentifierSet
    seen ComponentMap
    components DomainMap
    domainConfs Component
    top Text
    topName = (State
       backend ([(String, Doc)], [(String, String)], [(String, String)])
     -> backend
     -> ([(String, Doc)], [(String, String)], [(String, String)]))
    -> backend
    -> State
         backend ([(String, Doc)], [(String, String)], [(String, String)])
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip State
      backend ([(String, Doc)], [(String, String)], [(String, String)])
    -> backend
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    forall s a. State s a -> s -> a
    evalState backend
    backend (State
       backend ([(String, Doc)], [(String, String)], [(String, String)])
     -> ([(String, Doc)], [(String, String)], [(String, String)]))
    -> State
         backend ([(String, Doc)], [(String, String)], [(String, String)])
    -> ([(String, Doc)], [(String, String)], [(String, String)])
    forall a b. (a -> b) -> a -> b
    $ Ap
      (StateT backend Identity)
      ([(String, Doc)], [(String, String)], [(String, String)])
    -> State
         backend ([(String, Doc)], [(String, String)], [(String, String)])
    forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
    getAp (Ap
       (StateT backend Identity)
       ([(String, Doc)], [(String, String)], [(String, String)])
     -> State
          backend ([(String, Doc)], [(String, String)], [(String, String)]))
    -> Ap
         (StateT backend Identity)
         ([(String, Doc)], [(String, String)], [(String, String)])
    -> State
         backend ([(String, Doc)], [(String, String)], [(String, String)])
    forall a b. (a -> b) -> a -> b
    $ do
      let componentsL :: [(ComponentMeta, Component)]
    componentsL = ((Unique, (ComponentMeta, Component))
     -> (ComponentMeta, Component))
    -> [(Unique, (ComponentMeta, Component))]
    -> [(ComponentMeta, Component)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Unique, (ComponentMeta, Component)) -> (ComponentMeta, Component)
    forall a b. (a, b) -> b
    snd (ComponentMap -> [(Unique, (ComponentMeta, Component))]
    forall k v. OMap k v -> [(k, v)]
    OMap.assocs ComponentMap
    components)
      ([(String, Doc)]
    hdlNmDocs0,[[(String, Doc)]]
    incs) <-
        ([((String, Doc), [(String, Doc)])]
     -> ([(String, Doc)], [[(String, Doc)]]))
    -> Ap (StateT backend Identity) [((String, Doc), [(String, Doc)])]
    -> Ap
         (StateT backend Identity) ([(String, Doc)], [[(String, Doc)]])
    forall a b.
    (a -> b)
    -> Ap (StateT backend Identity) a -> Ap (StateT backend Identity) b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap [((String, Doc), [(String, Doc)])]
    -> ([(String, Doc)], [[(String, Doc)]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Ap (StateT backend Identity) [((String, Doc), [(String, Doc)])]
     -> Ap
          (StateT backend Identity) ([(String, Doc)], [[(String, Doc)]]))
    -> Ap (StateT backend Identity) [((String, Doc), [(String, Doc)])]
    -> Ap
         (StateT backend Identity) ([(String, Doc)], [[(String, Doc)]])
    forall a b. (a -> b) -> a -> b
    $
          [(ComponentMeta, Component)]
    -> ((ComponentMeta, Component)
        -> Ap (StateT backend Identity) ((String, Doc), [(String, Doc)]))
    -> Ap (StateT backend Identity) [((String, Doc), [(String, Doc)])]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(ComponentMeta, Component)]
    componentsL (((ComponentMeta, Component)
      -> Ap (StateT backend Identity) ((String, Doc), [(String, Doc)]))
     -> Ap (StateT backend Identity) [((String, Doc), [(String, Doc)])])
    -> ((ComponentMeta, Component)
        -> Ap (StateT backend Identity) ((String, Doc), [(String, Doc)]))
    -> Ap (StateT backend Identity) [((String, Doc), [(String, Doc)])]
    forall a b. (a -> b) -> a -> b
    $ \(ComponentMeta{SrcSpan
    cmLoc :: SrcSpan
    cmLoc :: ComponentMeta -> SrcSpan
    cmLoc, IdentifierSet
    cmScope :: IdentifierSet
    cmScope :: ComponentMeta -> IdentifierSet
    cmScope,UsageMap
    cmUsage :: UsageMap
    cmUsage :: ComponentMeta -> UsageMap
    cmUsage}, Component
    comp) ->
             ClashOpts
    -> Text
    -> SrcSpan
    -> IdentifierSet
    -> UsageMap
    -> Component
    -> Ap (StateT backend Identity) ((String, Doc), [(String, Doc)])
    forall state.
    Backend state =>
    ClashOpts
    -> Text
    -> SrcSpan
    -> IdentifierSet
    -> UsageMap
    -> Component
    -> Ap (State state) ((String, Doc), [(String, Doc)])
    genHDL ClashOpts
    opts Text
    modName SrcSpan
    cmLoc (HasCallStack => IdentifierSet -> IdentifierSet -> IdentifierSet
    IdentifierSet -> IdentifierSet -> IdentifierSet
    Id.union IdentifierSet
    seen IdentifierSet
    cmScope) UsageMap
    cmUsage Component
    comp

      [HWType]
    hwtys <- HashSet HWType -> [HWType]
    forall a. HashSet a -> [a]
    HashSet.toList (HashSet HWType -> [HWType])
    -> (backend -> HashSet HWType) -> backend -> [HWType]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> backend -> HashSet HWType
    forall state. Backend state => state -> HashSet HWType
    extractTypes (backend -> [HWType])
    -> Ap (StateT backend Identity) backend
    -> Ap (StateT backend Identity) [HWType]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT backend Identity backend
    -> Ap (StateT backend Identity) backend
    forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
    Ap StateT backend Identity backend
    forall s (m :: Type -> Type). MonadState s m => m s
    get
      [(String, Doc)]
    typesPkg0 <- Text -> [HWType] -> Ap (StateT backend Identity) [(String, Doc)]
    forall state.
    Backend state =>
    Text -> [HWType] -> Ap (State state) [(String, Doc)]
    mkTyPackage Text
    modName [HWType]
    hwtys
      [(String, String)]
    dataFiles <- StateT backend Identity [(String, String)]
    -> Ap (StateT backend Identity) [(String, String)]
    forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
    Ap StateT backend Identity [(String, String)]
    forall state. Backend state => State state [(String, String)]
    getDataFiles
      [(String, String)]
    memFiles  <- StateT backend Identity [(String, String)]
    -> Ap (StateT backend Identity) [(String, String)]
    forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
    Ap StateT backend Identity [(String, String)]
    forall state. Backend state => State state [(String, String)]
    getMemoryDataFiles
      let
        typesPkg1 :: [(String, Doc)]
    typesPkg1 = ((String, Doc) -> (String, Doc))
    -> [(String, Doc)] -> [(String, Doc)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> String) -> (String, Doc) -> (String, Doc)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: Type -> Type -> Type) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (String -> String -> String
    <.> backend -> String
    forall state. Backend state => state -> String
    Clash.Backend.extension backend
    backend)) [(String, Doc)]
    typesPkg0
        hdlNmDocs1 :: [(String, Doc)]
    hdlNmDocs1 = ((String, Doc) -> (String, Doc))
    -> [(String, Doc)] -> [(String, Doc)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> String) -> (String, Doc) -> (String, Doc)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: Type -> Type -> Type) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (String -> String -> String
    <.> backend -> String
    forall state. Backend state => state -> String
    Clash.Backend.extension backend
    backend)) [(String, Doc)]
    hdlNmDocs0
        topFiles :: [(String, Doc)]
    topFiles = [[(String, Doc)]] -> [(String, Doc)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[(String, Doc)]]
    incs [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, Doc)]
    typesPkg1 [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, Doc)]
    hdlNmDocs1

        topClks :: [(Text, Text)]
    topClks = Component -> [(Text, Text)]
    findClocks Component
    top
        sdcInfo :: [(Text, VDomainConfiguration)]
    sdcInfo = (Text -> VDomainConfiguration)
    -> (Text, Text) -> (Text, VDomainConfiguration)
    forall a b. (a -> b) -> (Text, a) -> (Text, b)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> VDomainConfiguration
    findDomainConfig ((Text, Text) -> (Text, VDomainConfiguration))
    -> [(Text, Text)] -> [(Text, VDomainConfiguration)]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, Text)]
    topClks
        sdcFile :: String
    sdcFile = Text -> String
    Data.Text.unpack Text
    topName String -> String -> String
    <.> String
    "sdc"
        sdcDoc :: (String, Doc)
    sdcDoc  = (String
    sdcFile, SdcInfo -> Doc
    pprSDC ([(Text, VDomainConfiguration)] -> SdcInfo
    SdcInfo [(Text, VDomainConfiguration)]
    sdcInfo))
        sdc :: Maybe (String, Doc)
    sdc = if [(Text, VDomainConfiguration)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [(Text, VDomainConfiguration)]
    sdcInfo then Maybe (String, Doc)
    forall a. Maybe a
    Nothing else (String, Doc) -> Maybe (String, Doc)
    forall a. a -> Maybe a
    Just (String, Doc)
    sdcDoc

      ([(String, Doc)], [(String, String)], [(String, String)])
    -> Ap
         (StateT backend Identity)
         ([(String, Doc)], [(String, String)], [(String, String)])
    forall a. a -> Ap (StateT backend Identity) a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Maybe (String, Doc) -> [(String, Doc)]
    forall a. Maybe a -> [a]
    maybeToList Maybe (String, Doc)
    sdc [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
    forall a. Semigroup a => a -> a -> a
    <> [(String, Doc)]
    topFiles, [(String, String)]
    dataFiles, [(String, String)]
    memFiles)
     where
      findDomainConfig :: Text -> VDomainConfiguration
    findDomainConfig Text
    dom =
        VDomainConfiguration -> Text -> DomainMap -> VDomainConfiguration
    forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    HashMap.lookupDefault
          (String -> VDomainConfiguration
    forall a. HasCallStack => String -> a
    error (String -> VDomainConfiguration) -> String -> VDomainConfiguration
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Unknown synthesis domain: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    dom)
          Text
    dom
          DomainMap
    domainConfs

    writeVerilatorShim
      :: FilePath
      -> Id.Identifier
      -> [(FilePath, ByteString)]
      -> IO [(FilePath, ByteString)]
    writeVerilatorShim :: String
    -> Identifier
    -> [(String, ByteString)]
    -> IO [(String, ByteString)]
    writeVerilatorShim String
    hdlDir Identifier
    topNm [(String, ByteString)]
    filesAndDigests = do
      let file :: String
    file = Text -> String
    Data.Text.unpack (Identifier -> Text
    Id.toText Identifier
    topNm) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "_shim" String -> String -> String
    <.> String
    "cpp"
      ByteString
    digest <- String -> (String, Doc) -> IO ByteString
    writeHDL String
    hdlDir (String
    file, Identifier -> Doc
    pprVerilatorShim Identifier
    topNm)
      [(String, ByteString)] -> IO [(String, ByteString)]
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((String
    file, ByteString
    digest) (String, ByteString)
    -> [(String, ByteString)] -> [(String, ByteString)]
    forall a. a -> [a] -> [a]
    : [(String, ByteString)]
    filesAndDigests)

    -- | Create a shim for using verilator, which loads the entity and steps
    -- through simulation until finished.
    --
    pprVerilatorShim :: Id.Identifier -> Doc
    pprVerilatorShim :: Identifier -> Doc
    pprVerilatorShim (Identifier -> Text
    Id.toText -> Text
    topNm) =
      -- Extra newlines are aggressively inserted so the quasiquoter doesn't wrap
      -- the outlines lines in the file. It doesn't matter for code inside main,
      -- but is fatal for the #include directives.
      Text -> Doc
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (Text -> Doc) -> Text -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    Data.Text.pack [I.i|
        \#include <cstdlib>

        \#include <verilated.h>

        \#include "V#{topNm}.h"

        int main(int argc, char **argv) {
          Verilated::commandArgs(argc, argv);

          V#{topNm} *top = new V#{topNm};

          while(!Verilated::gotFinish()) {
            top->eval();
          }

          top->final();

          delete top;

          return EXIT_SUCCESS;
        }
      |]

    writeEdam ::
      FilePath ->
      (Id.Identifier, Unique) ->
      HashMap Unique [Unique] ->
      HashMap Unique [EdamFile] ->
      [(FilePath, ByteString)] ->
      IO (HashMap Unique [EdamFile], [(FilePath, ByteString)])
    writeEdam :: String
    -> (Identifier, Unique)
    -> HashMap Unique [Unique]
    -> HashMap Unique [EdamFile]
    -> [(String, ByteString)]
    -> IO (HashMap Unique [EdamFile], [(String, ByteString)])
    writeEdam String
    hdlDir (Identifier
    topNm, Unique
    topEntity) HashMap Unique [Unique]
    deps HashMap Unique [EdamFile]
    edamFiles0 [(String, ByteString)]
    filesAndDigests = do
      let
        (HashMap Unique [EdamFile]
    edamFiles1, Edam
    edamInfo) =
          (Identifier, Unique)
    -> HashMap Unique [Unique]
    -> HashMap Unique [EdamFile]
    -> [String]
    -> (HashMap Unique [EdamFile], Edam)
    createEDAM (Identifier
    topNm, Unique
    topEntity) HashMap Unique [Unique]
    deps HashMap Unique [EdamFile]
    edamFiles0 (((String, ByteString) -> String)
    -> [(String, ByteString)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, ByteString) -> String
    forall a b. (a, b) -> a
    fst [(String, ByteString)]
    filesAndDigests)
      ByteString
    edamDigest <- String -> (String, Doc) -> IO ByteString
    writeHDL String
    hdlDir (String
    "edam.py", Edam -> Doc
    forall ann. Edam -> Doc ann
    pprEdam Edam
    edamInfo)
      (HashMap Unique [EdamFile], [(String, ByteString)])
    -> IO (HashMap Unique [EdamFile], [(String, ByteString)])
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HashMap Unique [EdamFile]
    edamFiles1, (String
    "edam.py", ByteString
    edamDigest) (String, ByteString)
    -> [(String, ByteString)] -> [(String, ByteString)]
    forall a. a -> [a] -> [a]
    : [(String, ByteString)]
    filesAndDigests)

    -- | Create an Edalize metadata file for using Edalize to build the project.
    --
    -- TODO: Handle libraries. Also see: https://github.com/olofk/edalize/issues/220
    createEDAM ::
      -- Top entity name and unique
      (Id.Identifier, Unique) ->
      -- | Top entity dependency map
      HashMap Unique [Unique] ->
      -- | Edam files of each top entity
      HashMap Unique [EdamFile] ->
      -- | Files to include in Edam file
      [FilePath] ->
      -- | (updated map, edam)
      (HashMap Unique [EdamFile], Edam)
    createEDAM :: (Identifier, Unique)
    -> HashMap Unique [Unique]
    -> HashMap Unique [EdamFile]
    -> [String]
    -> (HashMap Unique [EdamFile], Edam)
    createEDAM (Identifier
    topName, Unique
    topUnique) HashMap Unique [Unique]
    deps HashMap Unique [EdamFile]
    edamFileMap [String]
    files =
      (Unique
    -> [EdamFile]
    -> HashMap Unique [EdamFile]
    -> HashMap Unique [EdamFile]
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    HashMap.insert Unique
    topUnique (Edam -> [EdamFile]
    edamFiles Edam
    edam) HashMap Unique [EdamFile]
    edamFileMap, Edam
    edam)
     where
      edam :: Edam
    edam = Edam
        { edamProjectName :: Text
    edamProjectName = Identifier -> Text
    Id.toText Identifier
    topName
        , edamTopEntity :: Text
    edamTopEntity   = Identifier -> Text
    Id.toText Identifier
    topName
        , edamFiles :: [EdamFile]
    edamFiles       = (String -> EdamFile) -> [String] -> [EdamFile]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Identifier -> String -> EdamFile
    asEdamFile Identifier
    topName) [String]
    files [EdamFile] -> [EdamFile] -> [EdamFile]
    forall a. Semigroup a => a -> a -> a
    <> (EdamFile -> EdamFile) -> [EdamFile] -> [EdamFile]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap EdamFile -> EdamFile
    asIncFile [EdamFile]
    incFiles
        , edamToolOptions :: EdamTools
    edamToolOptions = EdamTools
    forall a. Default a => a
    def
        }

      incFiles :: [EdamFile]
    incFiles =
        (Unique -> [EdamFile]) -> [Unique] -> [EdamFile]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap
          (\Unique
    u -> [EdamFile] -> Unique -> HashMap Unique [EdamFile] -> [EdamFile]
    forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    HashMap.lookupDefault [] Unique
    u HashMap Unique [EdamFile]
    edamFileMap)
          ([Unique] -> Unique -> HashMap Unique [Unique] -> [Unique]
    forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    HashMap.lookupDefault [] Unique
    topUnique HashMap Unique [Unique]
    deps)

      asIncFile :: EdamFile -> EdamFile
    asIncFile EdamFile
    f =
        EdamFile
    f { efName = ".." </> Data.Text.unpack (efLogicalName f) </> efName f }

    asEdamFile :: Id.Identifier -> FilePath -> EdamFile
    asEdamFile :: Identifier -> String -> EdamFile
    asEdamFile Identifier
    topName String
    path =
      String -> EdamFileType -> Text -> EdamFile
    EdamFile String
    path EdamFileType
    edamFileType (Identifier -> Text
    Id.toText Identifier
    topName)
     where
      edamFileType :: EdamFileType
    edamFileType =
        case String -> String
    FilePath.takeExtension String
    path of
          String
    ".vhdl" -> EdamFileType
    VhdlSource
          String
    ".v" -> EdamFileType
    VerilogSource
          String
    ".sv" -> EdamFileType
    SystemVerilogSource
          String
    ".tcl" -> EdamFileType
    TclSource
          String
    ".qsys" -> EdamFileType
    QSYS
          String
    ".sdc" -> EdamFileType
    SDC
          String
    _ -> EdamFileType
    Clash.Edalize.Edam.Unknown

    -- | Prepares directory for writing HDL files.
    prepareDir ::
      -- | HDL directory to prepare
      FilePath ->
      -- | Relevant options: @-fclash-no-clean@
      ClashOpts ->
      -- | Did directory contain unexpected modifications? See 'readFreshManifest'
      Maybe [UnexpectedModification] ->
      IO ()
    prepareDir :: String -> ClashOpts -> Maybe [UnexpectedModification] -> IO ()
    prepareDir String
    hdlDir ClashOpts{Bool
    opt_clear :: Bool
    opt_clear :: ClashOpts -> Bool
    opt_clear} Maybe [UnexpectedModification]
    mods = do
      IO Bool -> IO () -> IO () -> IO ()
    forall (m :: Type -> Type) a.
    Monad m =>
    m Bool -> m a -> m a -> m a
    ifM
        (String -> IO Bool
    doesPathExist String
    hdlDir)
        (IO Bool -> IO () -> IO () -> IO ()
    forall (m :: Type -> Type) a.
    Monad m =>
    m Bool -> m a -> m a -> m a
    ifM
          (String -> IO Bool
    doesDirectoryExist String
    hdlDir)
          (IO ()
    detectCaseIssues IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> IO ()
    clearOrError IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> IO ()
    createDir)
          (String -> IO ()
    forall a. HasCallStack => String -> a
    error [I.i|Tried to write HDL files to #{hdlDir}, but it wasn't a directory.|]))
        IO ()
    createDir

     where
      createDir :: IO ()
    createDir = Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True String
    hdlDir

      -- Windows considers 'foo' and 'FOO' the same directory. Error if users tries
      -- to synthesize two top entities with conflicting (in this sense) names.
      detectCaseIssues :: IO ()
    detectCaseIssues = do
        [String]
    allPaths <- String -> IO [String]
    listDirectory (String -> String
    takeDirectory String
    hdlDir)
        Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless (String -> String
    takeFileName String
    hdlDir String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    `elem` [String]
    allPaths) (String -> IO ()
    forall a. HasCallStack => String -> a
    error [I.i|
          OS indicated #{hdlDir} existed, but Clash could not find it among the
          list of existing directories in #{takeDirectory hdlDir}:

            #{allPaths}

          This probably means your OS or filesystem is case-insensitive. Rename your
          top level binders in order to prevent this error message.
        |])

      clearOrError :: IO ()
    clearOrError =
        case Maybe [UnexpectedModification]
    mods of
          Just [] ->
            -- No unexpected changes, so no user work will get lost
            String -> IO ()
    removeDirectoryRecursive String
    hdlDir
          Maybe [UnexpectedModification]
    _ | Bool
    opt_clear ->
            -- Unexpected changes / non-empty directory, but @-fclash-clear@ was
            -- set, so remove directory anyway.
            String -> IO ()
    removeDirectoryRecursive String
    hdlDir
          Just [UnexpectedModification]
    unexpected ->
            -- Unexpected changes; i.e. modifications were made after last Clash run
            String -> IO ()
    forall a. HasCallStack => String -> a
    error [I.i|
              Changes were made to #{hdlDir} after last Clash run:

                #{pprintUnexpectedModifications 5 unexpected}

              Use '-fclash-clear' if you want Clash to clear out the directory.
              Warning: this will remove the complete directory, be cautious of data
              loss.
            |]
          Maybe [UnexpectedModification]
    Nothing ->
            -- No manifest file was found. Refuse to write if directory isn't empty.
            IO Bool -> IO () -> IO ()
    forall (m :: Type -> Type). Monad m => m Bool -> m () -> m ()
    unlessM
              ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null ([String] -> Bool) -> IO [String] -> IO Bool
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [String]
    listDirectory String
    hdlDir)
              (String -> IO ()
    forall a. HasCallStack => String -> a
    error [I.i|
                Tried to write HDL files to #{hdlDir}, but directory wasn't empty. This
                message will be supressed if Clash can detect that no files have
                changed since it was last run. If you're seeing this message even
                though you haven't modified any files, Clash encountered a problem
                reading "#{manifestFilename :: String}". This can happen when upgrading
                Clash.

                Use '-fclash-clear' if you want Clash to clear out the directory.
                Warning: this will remove the complete directory, be cautious of data
                loss.
              |])

    -- | Write a file to disk in chunks. Returns SHA256 sum of file contents.
    writeAndHash :: FilePath -> ByteStringLazy.ByteString -> IO ByteString
    writeAndHash :: String -> ByteString -> IO ByteString
    writeAndHash String
    path ByteString
    bs =
      String -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    IO.withFile String
    path IOMode
    IO.WriteMode ((Handle -> IO ByteString) -> IO ByteString)
    -> (Handle -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Handle
    handle ->
          (Ctx -> ByteString) -> IO Ctx -> IO ByteString
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap Ctx -> ByteString
    Sha256.finalize
        (IO Ctx -> IO ByteString) -> IO Ctx -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ (Ctx -> ByteString -> IO Ctx) -> Ctx -> [ByteString] -> IO Ctx
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (Handle -> Ctx -> ByteString -> IO Ctx
    writeChunk Handle
    handle) Ctx
    Sha256.init
        ([ByteString] -> IO Ctx) -> [ByteString] -> IO Ctx
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    ByteStringLazy.toChunks ByteString
    bs
     where
      writeChunk :: IO.Handle -> Sha256.Ctx -> ByteString -> IO Sha256.Ctx
      writeChunk :: Handle -> Ctx -> ByteString -> IO Ctx
    writeChunk Handle
    h !Ctx
    ctx ByteString
    chunk = do
        Handle -> ByteString -> IO ()
    ByteString.hPut Handle
    h ByteString
    chunk
        Ctx -> IO Ctx
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Ctx -> ByteString -> Ctx
    Sha256.update Ctx
    ctx ByteString
    chunk)

    -- | Writes a HDL file to the given directory. Returns SHA256 hash of written
    -- file.
    writeHDL :: FilePath -> (FilePath, Doc) -> IO ByteString
    writeHDL :: String -> (String, Doc) -> IO ByteString
    writeHDL String
    dir (String
    cname, Doc
    hdl) = do
      let
        layout :: LayoutOptions
    layout = PageWidth -> LayoutOptions
    LayoutOptions (Unique -> Double -> PageWidth
    AvailablePerLine Unique
    120 Double
    0.4)
        rendered0 :: Text
    rendered0 = SimpleDocStream () -> Text
    forall ann. SimpleDocStream ann -> Text
    renderLazy (LayoutOptions -> Doc -> SimpleDocStream ()
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
    layoutPretty LayoutOptions
    layout Doc
    hdl)
        rendered1 :: Text
    rendered1 = [Text] -> Text
    Text.unlines ((Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    Text.stripEnd (Text -> [Text]
    Text.lines Text
    rendered0))
      String -> ByteString -> IO ByteString
    writeAndHash (String
    dir String -> String -> String
    </> String
    cname) (Text -> ByteString
    Text.encodeUtf8 (Text
    rendered1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n"))

    -- | Copy given files
    writeMemoryDataFiles
        :: FilePath
        -- ^ Directory to copy  files to
        -> [(FilePath, String)]
        -- ^ (filename, content)
        -> IO [ByteString]
    writeMemoryDataFiles :: String -> [(String, String)] -> IO [ByteString]
    writeMemoryDataFiles String
    dir [(String, String)]
    files =
      [(String, String)]
    -> ((String, String) -> IO ByteString) -> IO [ByteString]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(String, String)]
    files (((String, String) -> IO ByteString) -> IO [ByteString])
    -> ((String, String) -> IO ByteString) -> IO [ByteString]
    forall a b. (a -> b) -> a -> b
    $ \(String
    fname, String
    content) ->
        String -> ByteString -> IO ByteString
    writeAndHash (String
    dir String -> String -> String
    </> String
    fname) (String -> ByteString
    ByteStringLazyChar8.pack String
    content)

    -- | Copy data files added with ~FILE
    copyDataFiles
      :: [FilePath]
      -- ^ Import directories passed in with @-i@
      -> FilePath
      -- ^ Directory to copy to
      -> [(FilePath,FilePath)]
      -- ^ [(name of newly made file in HDL output dir, file to copy)]
      -> IO [ByteString]
      -- ^ SHA256 hashes of written files
    copyDataFiles :: [String] -> String -> [(String, String)] -> IO [ByteString]
    copyDataFiles [String]
    idirs String
    targetDir = ((String, String) -> IO ByteString)
    -> [(String, String)] -> IO [ByteString]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM (String, String) -> IO ByteString
    copyDataFile
     where
      copyDataFile :: (FilePath, FilePath) -> IO ByteString
      copyDataFile :: (String, String) -> IO ByteString
    copyDataFile (String
    newName, String
    toCopy)
        | String -> Bool
    isAbsolute String
    toCopy = do
          IO Bool -> IO ByteString -> IO ByteString -> IO ByteString
    forall (m :: Type -> Type) a.
    Monad m =>
    m Bool -> m a -> m a -> m a
    ifM
            (String -> IO Bool
    doesFileExist String
    toCopy)
            (String -> String -> IO ByteString
    copyAndHash String
    toCopy (String
    targetDir String -> String -> String
    </> String
    newName))
            (String -> IO ByteString
    forall a. HasCallStack => String -> a
    error [I.i|Could not find data file #{show toCopy}. Does it exist?|])
        | Bool
    otherwise = do
          let candidates :: [String]
    candidates = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> String
    </> String
    toCopy) [String]
    idirs
          [String]
    found <- (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: Type -> Type) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> IO Bool
    doesFileExist [String]
    candidates
          case [String]
    found of
            [] -> String -> IO ByteString
    forall a. HasCallStack => String -> a
    error [I.i|
              Could not find data file #{show toCopy}. The following directories were
              searched:

                #{idirs}

              You can add directories Clash will look in using `-i`.
            |]
            (String
    _:String
    _:[String]
    _) -> String -> IO ByteString
    forall a. HasCallStack => String -> a
    error [I.i|
              Multiple data files for #{show toCopy} found. The following candidates
              were found:

                #{found}

              Please disambiguate data files.
            |]
            [String
    c] ->
              String -> String -> IO ByteString
    copyAndHash String
    c (String
    targetDir String -> String -> String
    </> String
    newName)

      copyAndHash :: String -> String -> IO ByteString
    copyAndHash String
    src String
    dst = do
        IO Bool -> IO ByteString -> IO ByteString -> IO ByteString
    forall (m :: Type -> Type) a.
    Monad m =>
    m Bool -> m a -> m a -> m a
    ifM
          (String -> IO Bool
    doesPathExist String
    dst)
          (String -> IO ByteString
    forall a. HasCallStack => String -> a
    error [I.i|
            Tried to copy data file #{src} to #{dst} but a file or directory with
            that name already existed. This is a bug in Clash, please report it.
          |])
          (String -> IO ByteString
    ByteStringLazy.readFile String
    src IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ByteString -> IO ByteString
    writeAndHash String
    dst)

    -- | Normalize a complete hierarchy
    normalizeEntity
      :: ClashEnv
      -> BindingMap
      -- ^ All bindings
      -> (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -- ^ Hardcoded 'Type' -> 'HWType' translator
      -> PE.Evaluator
      -- ^ Hardcoded evaluator for partial evaluation
      -> WHNF.Evaluator
      -- ^ Hardcoded evaluator for WHNF (old evaluator)
      -> [Id]
      -- ^ TopEntities
      -> Supply.Supply
      -- ^ Unique supply
      -> Id
      -- ^ root of the hierarchy
      -> IO BindingMap
    normalizeEntity :: ClashEnv
    -> BindingMap
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either String FilteredHWType)))
    -> Evaluator
    -> Evaluator
    -> [Id]
    -> Supply
    -> Id
    -> IO BindingMap
    normalizeEntity ClashEnv
    env BindingMap
    bindingsMap CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either String FilteredHWType))
    typeTrans Evaluator
    peEval Evaluator
    eval [Id]
    topEntities Supply
    supply Id
    tm = IO BindingMap
    transformedBindings
      where
        doNorm :: RewriteMonad NormalizeState BindingMap
    doNorm = do BindingMap
    norm <- [Id] -> RewriteMonad NormalizeState BindingMap
    normalize [Id
    tm]
                    let normChecked :: BindingMap
    normChecked = BindingMap -> BindingMap
    checkNonRecursive BindingMap
    norm
                    BindingMap
    cleaned <- Id -> BindingMap -> RewriteMonad NormalizeState BindingMap
    cleanupGraph Id
    tm BindingMap
    normChecked
                    BindingMap -> RewriteMonad NormalizeState BindingMap
    forall a. a -> RewriteMonad NormalizeState a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return BindingMap
    cleaned
        transformedBindings :: IO BindingMap
    transformedBindings = ClashEnv
    -> Supply
    -> BindingMap
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either String FilteredHWType)))
    -> Evaluator
    -> Evaluator
    -> VarEnv Bool
    -> [Id]
    -> RewriteMonad NormalizeState BindingMap
    -> IO BindingMap
    forall a.
    ClashEnv
    -> Supply
    -> BindingMap
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either String FilteredHWType)))
    -> Evaluator
    -> Evaluator
    -> VarEnv Bool
    -> [Id]
    -> NormalizeSession a
    -> IO a
    runNormalization ClashEnv
    env Supply
    supply BindingMap
    bindingsMap
                                CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either String FilteredHWType))
    typeTrans Evaluator
    peEval Evaluator
    eval VarEnv Bool
    forall a. VarEnv a
    emptyVarEnv
                                [Id]
    topEntities RewriteMonad NormalizeState BindingMap
    doNorm

    -- | Reverse topologically sort given top entities. Also returns a mapping that
    -- maps a top entity to its reverse topologically sorted transitive dependencies.
    sortTop ::
      BindingMap ->
      [TopEntityT] ->
      ( [TopEntityT]
      , HashMap Unique [Unique]
      )
    sortTop :: BindingMap
    -> [TopEntityT] -> ([TopEntityT], HashMap Unique [Unique])
    sortTop BindingMap
    bindingsMap [TopEntityT]
    topEntities =
      case [(Unique, TopEntityT)]
    -> [(Unique, Unique)] -> Either String [TopEntityT]
    forall a. [(Unique, a)] -> [(Unique, Unique)] -> Either String [a]
    reverseTopSort [(Unique, TopEntityT)]
    nodes [(Unique, Unique)]
    edges of
        Left String
    msg   -> String -> ([TopEntityT], HashMap Unique [Unique])
    forall a. HasCallStack => String -> a
    error String
    msg
        Right [TopEntityT]
    tops -> ([TopEntityT]
    tops, [TopEntityT] -> HashMap Unique [Unique]
    mapFrom [TopEntityT]
    tops)
     where
      nodes :: [(Unique, TopEntityT)]
    nodes = [(Id -> Unique
    forall a. Var a -> Unique
    varUniq Id
    topE, TopEntityT
    t) | t :: TopEntityT
    t@(TopEntityT Id
    topE Maybe TopEntity
    _ Bool
    _) <- [TopEntityT]
    topEntities]
      edges :: [(Unique, Unique)]
    edges = (TopEntityT -> [(Unique, Unique)])
    -> [TopEntityT] -> [(Unique, Unique)]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap TopEntityT -> [(Unique, Unique)]
    getEdges [TopEntityT]
    topEntities

      getEdges :: TopEntityT -> [(Unique, Unique)]
    getEdges (TopEntityT Id
    topE Maybe TopEntity
    _ Bool
    _) =
        (TopEntityT -> (Unique, Unique))
    -> [TopEntityT] -> [(Unique, Unique)]
    forall a b. (a -> b) -> [a] -> [b]
    map
          (\TopEntityT
    top -> (Id -> Unique
    forall a. Var a -> Unique
    varUniq Id
    topE, TopEntityT -> Unique
    topToUnique TopEntityT
    top))
          (Id -> [TopEntityT]
    getTransitiveRefs Id
    topE)

      getTransitiveRefs :: Id -> [TopEntityT]
    getTransitiveRefs Id
    top =
        let allDeps :: CallGraph
    allDeps = BindingMap -> Id -> CallGraph
    callGraph BindingMap
    bindingsMap Id
    top
        in  (TopEntityT -> Bool) -> [TopEntityT] -> [TopEntityT]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\TopEntityT
    t -> TopEntityT -> Id
    topId TopEntityT
    t Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Id
    top Bool -> Bool -> Bool
    && TopEntityT -> Id
    topId TopEntityT
    t Id -> CallGraph -> Bool
    forall a b. Var a -> VarEnv b -> Bool
    `elemVarEnv` CallGraph
    allDeps) [TopEntityT]
    topEntities

      topToUnique :: TopEntityT -> Unique
    topToUnique = Id -> Unique
    forall a. Var a -> Unique
    varUniq (Id -> Unique) -> (TopEntityT -> Id) -> TopEntityT -> Unique
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TopEntityT -> Id
    topId

      mapFrom :: [TopEntityT] -> HashMap Unique [Unique]
    mapFrom [TopEntityT]
    tops =
        let
          topIndices :: HashMap Unique Unique
    topIndices = [(Unique, Unique)] -> HashMap Unique Unique
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ([Unique] -> [Unique] -> [(Unique, Unique)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((TopEntityT -> Unique) -> [TopEntityT] -> [Unique]
    forall a b. (a -> b) -> [a] -> [b]
    map TopEntityT -> Unique
    topToUnique [TopEntityT]
    tops) [(Unique
    0 :: Int)..])
          nonOrdered :: HashMap Unique [Unique]
    nonOrdered = ([Unique] -> [Unique] -> [Unique])
    -> [(Unique, [Unique])] -> HashMap Unique [Unique]
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> [(k, v)] -> HashMap k v
    HashMap.fromListWith [Unique] -> [Unique] -> [Unique]
    forall a. Semigroup a => a -> a -> a
    (<>) (((Unique, Unique) -> (Unique, [Unique]))
    -> [(Unique, Unique)] -> [(Unique, [Unique])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Unique -> [Unique]) -> (Unique, Unique) -> (Unique, [Unique])
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: Type -> Type -> Type) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second Unique -> [Unique]
    forall a. a -> [a]
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure) [(Unique, Unique)]
    edges)
          orderFunc :: Unique -> Unique
    orderFunc Unique
    k = Unique -> Maybe Unique -> Unique
    forall a. a -> Maybe a -> a
    fromMaybe (-Unique
    1) (Unique -> HashMap Unique Unique -> Maybe Unique
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMap.lookup Unique
    k HashMap Unique Unique
    topIndices)
        in
          ([Unique] -> [Unique])
    -> HashMap Unique [Unique] -> HashMap Unique [Unique]
    forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
    HashMap.map ((Unique -> Unique) -> [Unique] -> [Unique]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    List.sortOn Unique -> Unique
    orderFunc) HashMap Unique [Unique]
    nonOrdered