    {-# LANGUAGE NamedFieldPuns #-}
    {-|
      Copyright  :  (C) 2012-2016, University of Twente,
                        2016-2017, Myrtle Software Ltd,
                        2017     , Google Inc.,
                        2021-2024, QBayLogic B.V.
                        2022     , Google Inc.
      License    :  BSD2 (see the file LICENSE)
      Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

      Functions to create BlackBox Contexts and fill in BlackBox templates
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Clash.Netlist.BlackBox
        ( mkBlackBoxContext
        , extractPrimWarnOrFail
        , mkPrimitive
        , prepareBlackBox
        , isLiteral
        ) where

    import           Control.Exception             (throw)
    import           Control.Lens                  ((%=))
    import qualified Control.Lens                  as Lens
    import           Control.Monad                 (when, replicateM, zipWithM)
    import           Control.Monad.Extra           (concatMapM)
    import           Control.Monad.IO.Class        (liftIO)
    import           Data.Bifunctor                (first, second)
    import           Data.Either                   (lefts, partitionEithers)
    import           Data.Foldable                 (for_)
    import qualified Data.HashMap.Lazy             as HashMap
    import qualified Data.IntMap                   as IntMap
    import           Data.List.NonEmpty            (NonEmpty (..))
    import           Data.List                     (elemIndex, partition)
    import           Data.List.Extra               (countEq, mapAccumLM)
    import           Data.Maybe                    (listToMaybe, fromJust, fromMaybe)
    import           Data.Monoid                   (Ap(getAp))
    import qualified Data.Set                      as Set
    import           Data.Text.Lazy                (fromStrict)
    import qualified Data.Text.Lazy                as Text
    import           Data.Text                     (unpack)
    import qualified Data.Text                     as TextS
    import           Data.Text.Extra
    import           GHC.Stack
      (HasCallStack, callStack, prettyCallStack)
    import qualified System.Console.ANSI           as ANSI
    import           System.Console.ANSI
      ( hSetSGR, SGR(SetConsoleIntensity, SetColor), Color(Magenta, Red)
      , ConsoleIntensity(BoldIntensity), ConsoleLayer(Foreground), ColorIntensity(Vivid))
    import           System.IO
      (hPutStrLn, stderr, hFlush, hIsTerminalDevice)

    import           Clash.Annotations.Primitive
      ( PrimitiveGuard(HasBlackBox, DontTranslate)
      , PrimitiveWarning(WarnNonSynthesizable, WarnAlways)
      , extractPrim, HDL(VHDL))
    import           Clash.Core.DataCon            as D (dcTag)
    import           Clash.Core.FreeVars           (freeIds)
    import           Clash.Core.HasType
    import           Clash.Core.Literal            as C (Literal (..))
    import           Clash.Core.Name
      (Name (..), mkUnsafeSystemName)
    import qualified Clash.Netlist.Id              as Id
    import           Clash.Core.Pretty             (showPpr)
    import           Clash.Core.Subst              (extendIdSubst, mkSubst, substTm)
    import           Clash.Core.Term               as C
      (IsMultiPrim (..), PrimInfo (..), Term (..), WorkInfo (..), collectArgs,
       collectArgsTicks, collectBndrs, mkApps, PrimUnfolding(..))
    import           Clash.Core.TermInfo
    import           Clash.Core.Type               as C
      (Type (..), ConstTy (..), TypeView (..), mkFunTy, splitFunTys, tyView)
    import           Clash.Core.TyCon              as C (TyConMap, tyConDataCons)
    import           Clash.Core.Util
      (inverseTopSortLetBindings, splitShouldSplit)
    import           Clash.Core.Var                as V
      (Id, mkLocalId, modifyVarName, varType)
    import           Clash.Core.VarEnv
      (extendInScopeSet, mkInScopeSet, lookupVarEnv, uniqAway, unitVarSet)
    import {-# SOURCE #-} Clash.Netlist
      (genComponent, mkDcApplication, mkDeclarations, mkExpr, mkNetDecl,
       mkProjection, mkSelection, mkFunApp, mkDeclarations')
    import qualified Clash.Backend                 as Backend
    import qualified Clash.Data.UniqMap as UniqMap
    import           Clash.Debug                   (debugIsOn)
    import           Clash.Driver.Bool             (OverridingBool(..))
    import           Clash.Driver.Types
      (ClashOpts(opt_primWarn, opt_color, opt_werror))
    import           Clash.Netlist.BlackBox.Types  as B
    import           Clash.Netlist.BlackBox.Util   as B
    import           Clash.Netlist.Types           as N
    import           Clash.Netlist.Util            as N
    import           Clash.Normalize.Primitives    (removedArg)
    import           Clash.Primitives.Types        as P
    import qualified Clash.Primitives.Util         as P
    import           Clash.Signal.Internal         (ActiveEdge (..))
    import           Clash.Util
    import qualified Clash.Util.Interpolate        as I

    -- | Emits (colorized) warning to stderr
    warn
      :: ClashOpts
      -> String
      -> IO ()
    warn :: ClashOpts -> [Char] -> IO ()
    warn ClashOpts
    opts [Char]
    msg = do
      -- TODO: Put in appropriate module
      useColor <-
        case ClashOpts -> OverridingBool
    opt_color ClashOpts
    opts of
          OverridingBool
    Always -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Bool
    True
          OverridingBool
    Never  -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Bool
    False
          OverridingBool
    Auto   -> Handle -> IO Bool
    hIsTerminalDevice Handle
    stderr

      hSetSGR stderr [SetConsoleIntensity BoldIntensity]

      case opt_werror opts of
        Bool
    True -> do
          Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when Bool
    useColor (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> [SGR] -> IO ()
    hSetSGR Handle
    stderr [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Red]
          ClashException -> IO ()
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    noSrcSpan [Char]
    msg Maybe [Char]
    forall a. Maybe a
    Nothing)

        Bool
    False -> do
          Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when Bool
    useColor (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> [SGR] -> IO ()
    hSetSGR Handle
    stderr [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid Color
    Magenta]
          Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "[WARNING] " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    msg
          Handle -> [SGR] -> IO ()
    hSetSGR Handle
    stderr [SGR
    ANSI.Reset]
          Handle -> IO ()
    hFlush Handle
    stderr

    -- | Generate the context for a BlackBox instantiation.
    mkBlackBoxContext
      :: HasCallStack
      => TextS.Text
      -- ^ Blackbox function name
      -> DeclarationType
      -- ^ Are we concurrent or sequential?
      -> [Id]
      -- ^ Identifiers binding the primitive/blackbox application
      -> [Either Term Type]
      -- ^ Arguments of the primitive/blackbox application
      -> NetlistMonad (BlackBoxContext,[Declaration])
    mkBlackBoxContext :: HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext Text
    bbName DeclarationType
    declType [Id]
    resIds args :: [Either Term Type]
    args@([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts -> [Term]
    termArgs) = do
        -- Make context inputs
        let
          resNms :: [Identifier]
    resNms = (Id -> Identifier) -> [Id] -> [Identifier]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId [Id]
    resIds
          resNm :: Identifier
    resNm = Identifier -> Maybe Identifier -> Identifier
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Identifier
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "mkBlackBoxContext: head") ([Identifier] -> Maybe Identifier
    forall a. [a] -> Maybe a
    listToMaybe [Identifier]
    resNms)
        resTys <- (Id -> NetlistMonad HWType) -> [Id] -> NetlistMonad [HWType]
    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 ([Char] -> Type -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' $(curLoc) (Type -> NetlistMonad HWType)
    -> (Id -> Type) -> Id -> NetlistMonad HWType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf) [Id]
    resIds
        (imps,impDecls) <- unzip <$> zipWithM (mkArgument bbName resNm declType) [0..] termArgs
        (funs,funDecls) <-
          mapAccumLM
            (addFunction (map coreTypeOf resIds))
            IntMap.empty
            (zip termArgs [0..])

        -- Make context result
        let ress = (Identifier -> Expr) -> [Identifier] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Identifier -> Maybe Modifier -> Expr)
    -> Maybe Modifier -> Identifier -> Expr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Identifier -> Maybe Modifier -> Expr
    Identifier Maybe Modifier
    forall a. Maybe a
    Nothing) [Identifier]
    resNms

        lvl <- Lens.use curBBlvl
        (nm,_) <- Lens.use curCompNm

        -- Set "context name" to value set by `Clash.Magic.setName`, default to the
        -- name of the closest binder
        ctxName1 <- fromMaybe (map Id.toText resNms) . fmap pure <$> Lens.view setName
        -- Update "context name" with prefixes and suffixes set by
        -- `Clash.Magic.prefixName` and `Clash.Magic.suffixName`
        ctxName2 <- mapM affixName ctxName1

        return ( Context bbName (zip ress resTys) imps funs [] lvl nm (listToMaybe ctxName2)
               , concat impDecls ++ concat funDecls
               )
      where
        addFunction :: [Type]
    -> IntMap
         [(Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext)]
    -> (Term, Int)
    -> NetlistMonad
         (IntMap
            [(Either BlackBox (Identifier, [Declaration]), Usage,
              [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
              BlackBoxContext)],
          [Declaration])
    addFunction [Type]
    resTys IntMap
      [(Either BlackBox (Identifier, [Declaration]), Usage,
        [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
        BlackBoxContext)]
    im (Term
    arg,Int
    i) = do
          tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
          if isFun tcm arg then do
            -- Only try to calculate function plurality when primitive actually
            -- exists. Here to prevent crashes on __INTERNAL__ primitives.
            prim <- HashMap.lookup bbName <$> Lens.view primitives
            funcPlurality <-
              case extractPrim <$> prim of
                Just (Just CompiledPrimitive
    p) ->
                  HasCallStack =>
    CompiledPrimitive
    -> [Either Term Type] -> [Type] -> Int -> NetlistMonad Int
    CompiledPrimitive
    -> [Either Term Type] -> [Type] -> Int -> NetlistMonad Int
    P.getFunctionPlurality CompiledPrimitive
    p [Either Term Type]
    args [Type]
    resTys Int
    i
                Maybe (Maybe CompiledPrimitive)
    _ ->
                  Int -> NetlistMonad Int
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Int
    1

            curBBlvl Lens.+= 1
            (fs,ds) <- case resIds of
              (Id
    resId:[Id]
    _) -> [((Either BlackBox (Identifier, [Declaration]), Usage,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext),
      [Declaration])]
    -> ([(Either BlackBox (Identifier, [Declaration]), Usage,
          [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
          BlackBoxContext)],
        [[Declaration]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([((Either BlackBox (Identifier, [Declaration]), Usage,
        [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
        BlackBoxContext),
       [Declaration])]
     -> ([(Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext)],
         [[Declaration]]))
    -> NetlistMonad
         [((Either BlackBox (Identifier, [Declaration]), Usage,
            [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
            BlackBoxContext),
           [Declaration])]
    -> NetlistMonad
         ([(Either BlackBox (Identifier, [Declaration]), Usage,
            [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
            BlackBoxContext)],
          [[Declaration]])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    -> NetlistMonad
         [((Either BlackBox (Identifier, [Declaration]), Usage,
            [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
            BlackBoxContext),
           [Declaration])]
    forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    funcPlurality (HasCallStack =>
    Text
    -> DeclarationType
    -> Id
    -> Term
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    Text
    -> DeclarationType
    -> Id
    -> Term
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    mkFunInput Text
    bbName DeclarationType
    declType Id
    resId Term
    arg)
              [Id]
    _ -> [Char]
    -> NetlistMonad
         ([(Either BlackBox (Identifier, [Declaration]), Usage,
            [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
            BlackBoxContext)],
          [[Declaration]])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient resIds"
            curBBlvl Lens.-= 1

            let im' = Int
    -> [(Either BlackBox (Identifier, [Declaration]), Usage,
         [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
         BlackBoxContext)]
    -> IntMap
         [(Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext)]
    -> IntMap
         [(Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext)]
    forall a. Int -> a -> IntMap a -> IntMap a
    IntMap.insert Int
    i [(Either BlackBox (Identifier, [Declaration]), Usage,
      [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
      BlackBoxContext)]
    fs IntMap
      [(Either BlackBox (Identifier, [Declaration]), Usage,
        [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
        BlackBoxContext)]
    im
            return (im', concat ds)
          else
            return (im, [])

    prepareBlackBox
      :: TextS.Text
      -> BlackBox
      -> BlackBoxContext
      -> NetlistMonad (BlackBox,[Declaration])
    prepareBlackBox :: Text
    -> BlackBox
    -> BlackBoxContext
    -> NetlistMonad (BlackBox, [Declaration])
    prepareBlackBox Text
    _pNm BlackBox
    templ BlackBoxContext
    bbCtx =
      case BlackBoxContext -> BlackBox -> Maybe [Char]
    verifyBlackBoxContext BlackBoxContext
    bbCtx BlackBox
    templ of
        Maybe [Char]
    Nothing -> do
          (t2,decls) <-
            (BlackBoxTemplate -> NetlistMonad (BlackBox, [Declaration]))
    -> ([Char]
        -> Int
        -> TemplateFunction
        -> NetlistMonad (BlackBox, [Declaration]))
    -> BlackBox
    -> NetlistMonad (BlackBox, [Declaration])
    forall r.
    (BlackBoxTemplate -> r)
    -> ([Char] -> Int -> TemplateFunction -> r) -> BlackBox -> r
    onBlackBox
              (((BlackBoxTemplate, [Declaration]) -> (BlackBox, [Declaration]))
    -> NetlistMonad (BlackBoxTemplate, [Declaration])
    -> NetlistMonad (BlackBox, [Declaration])
    forall a b. (a -> b) -> NetlistMonad a -> NetlistMonad b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((BlackBoxTemplate -> BlackBox)
    -> (BlackBoxTemplate, [Declaration]) -> (BlackBox, [Declaration])
    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 BlackBoxTemplate -> BlackBox
    BBTemplate) (NetlistMonad (BlackBoxTemplate, [Declaration])
     -> NetlistMonad (BlackBox, [Declaration]))
    -> (BlackBoxTemplate
        -> NetlistMonad (BlackBoxTemplate, [Declaration]))
    -> BlackBoxTemplate
    -> NetlistMonad (BlackBox, [Declaration])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlackBoxContext
    -> BlackBoxTemplate
    -> NetlistMonad (BlackBoxTemplate, [Declaration])
    forall (m :: Type -> Type).
    IdentifierSetMonad m =>
    BlackBoxContext
    -> BlackBoxTemplate -> m (BlackBoxTemplate, [Declaration])
    setSym BlackBoxContext
    bbCtx)
              (\[Char]
    bbName Int
    bbHash TemplateFunction
    bbFunc -> (BlackBox, [Declaration]) -> NetlistMonad (BlackBox, [Declaration])
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Char] -> Int -> TemplateFunction -> BlackBox
    BBFunction [Char]
    bbName Int
    bbHash TemplateFunction
    bbFunc, []))
              BlackBox
    templ
          for_ decls goDecl
          return (t2,decls)
        Just [Char]
    err0 -> do
          (_,sp) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    -> NetlistMonad (Identifier, SrcSpan)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    Lens' NetlistState (Identifier, SrcSpan)
    curCompNm
          let err1 = [[Char]] -> [Char]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [ [Char]
    "Couldn't instantiate blackbox for "
                            , Text -> [Char]
    Data.Text.unpack (BlackBoxContext -> Text
    bbName BlackBoxContext
    bbCtx), [Char]
    ". Verification "
                            , [Char]
    "procedure reported:\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err0 ]
          throw (ClashException sp ($(curLoc) ++ err1) Nothing)
     where
      -- Right now we assume that (1) a blackbox doesn't assign to a signal
      -- declared outside the black box template and (2) all uses of a signal
      -- within a blackbox are correct for the targeted HDL (i.e. we don't try
      -- to generate new signals when a signal is used incorrectly).
      goDecl :: Declaration -> NetlistMonad ()
    goDecl = \case
        Assignment Identifier
    i Usage
    u Expr
    _ ->
          Usage -> Identifier -> NetlistMonad ()
    declareUse Usage
    u Identifier
    i

        CondAssignment Identifier
    i HWType
    _ Expr
    _ HWType
    _ [(Maybe Literal, Expr)]
    _ -> do
          -- Currently, all CondAssignment get rendered as `always @*` blocks in
          -- (System)Verilog. This means when we target these HDL, this is _really_
          -- a blocking procedural assignment.
          SomeBackend b <- Getting SomeBackend NetlistState SomeBackend
    -> NetlistMonad SomeBackend
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting SomeBackend NetlistState SomeBackend
    Lens' NetlistState SomeBackend
    backend
          let use = case backend -> HDL
    forall state. Backend state => state -> HDL
    Backend.hdlKind backend
    b of { HDL
    VHDL -> Usage
    Cont ; HDL
    _ -> Blocking -> Usage
    Proc Blocking
    Blocking }
          declareUse use i

        Seq [Seq]
    seqs -> [Seq] -> (Seq -> NetlistMonad ()) -> NetlistMonad ()
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [Seq]
    seqs Seq -> NetlistMonad ()
    goSeq

        Declaration
    _ -> () -> NetlistMonad ()
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ()

      goSeq :: Seq -> NetlistMonad ()
    goSeq = \case
        AlwaysClocked ActiveEdge
    _ Expr
    _ [Seq]
    seqs ->
          [Seq] -> (Seq -> NetlistMonad ()) -> NetlistMonad ()
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [Seq]
    seqs Seq -> NetlistMonad ()
    goSeq

        Initial [Seq]
    seqs ->
          [Seq] -> (Seq -> NetlistMonad ()) -> NetlistMonad ()
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [Seq]
    seqs Seq -> NetlistMonad ()
    goSeq

        AlwaysComb [Seq]
    seqs ->
          [Seq] -> (Seq -> NetlistMonad ()) -> NetlistMonad ()
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [Seq]
    seqs Seq -> NetlistMonad ()
    goSeq

        SeqDecl Declaration
    conc ->
          Declaration -> NetlistMonad ()
    goDecl Declaration
    conc

        Branch Expr
    _ HWType
    _ [(Maybe Literal, [Seq])]
    alts ->
          let seqs :: [Seq]
    seqs = ((Maybe Literal, [Seq]) -> [Seq])
    -> [(Maybe Literal, [Seq])] -> [Seq]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (Maybe Literal, [Seq]) -> [Seq]
    forall a b. (a, b) -> b
    snd [(Maybe Literal, [Seq])]
    alts
           in [Seq] -> (Seq -> NetlistMonad ()) -> NetlistMonad ()
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [Seq]
    seqs Seq -> NetlistMonad ()
    goSeq

    -- | Determine if a term represents a literal
    isLiteral :: Term -> Bool
    isLiteral :: Term -> Bool
    isLiteral Term
    e = case Term -> (Term, [Either Term Type])
    collectArgs Term
    e of
      (Data DataCon
    _, [Either Term Type]
    args)   -> (Either Term Type -> Bool) -> [Either Term Type] -> Bool
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Bool
    all ((Term -> Bool) -> (Type -> Bool) -> Either Term Type -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Term -> Bool
    isLiteral (Bool -> Type -> Bool
    forall a b. a -> b -> a
    const Bool
    True)) [Either Term Type]
    args
      (Prim PrimInfo
    _, [Either Term Type]
    args) -> (Either Term Type -> Bool) -> [Either Term Type] -> Bool
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Bool
    all ((Term -> Bool) -> (Type -> Bool) -> Either Term Type -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Term -> Bool
    isLiteral (Bool -> Type -> Bool
    forall a b. a -> b -> a
    const Bool
    True)) [Either Term Type]
    args
      (C.Literal Literal
    _,[Either Term Type]
    _)  -> Bool
    True
      (Term, [Either Term Type])
    _                -> Bool
    False

    mkArgument
      :: TextS.Text
      -- ^ Blackbox function name
      -> Identifier
      -- ^ LHS of the original let-binder. Is used as a name hint to generate new
      -- names in case the argument is a declaration.
      -> DeclarationType
      -- ^ Are we concurrent or sequential?
      -> Int
      -- ^ Argument n (zero-indexed). Used for error message.
      -> Term
      -> NetlistMonad ( (Expr,HWType,Bool)
                      , [Declaration]
                      )
    mkArgument :: Text
    -> Identifier
    -> DeclarationType
    -> Int
    -> Term
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    mkArgument Text
    bbName Identifier
    bndr DeclarationType
    declType Int
    nArg Term
    e = do
        tcm   <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
        let ty = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    e
        iw    <- Lens.view intWidth
        hwTyM <- fmap stripFiltered <$> N.termHWTypeM e
        let eTyMsg = [Char]
    "(" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " :: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type
    ty [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
        ((e',t,l),d) <- case hwTyM of
          Maybe HWType
    Nothing
            | (Prim PrimInfo
    p,[Either Term Type]
    _) <- Term -> (Term, [Either Term Type])
    collectArgs Term
    e
            , PrimInfo -> Text
    primName PrimInfo
    p Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Text
    forall a. Show a => a -> Text
    showt 'removedArg
            -> ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Name -> Text
    forall a. Show a => a -> Text
    showt 'removedArg)) Maybe Modifier
    forall a. Maybe a
    Nothing, Maybe HWType -> HWType
    Void Maybe HWType
    forall a. Maybe a
    Nothing, Bool
    False), [])
            | Bool
    otherwise
            -> ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (([Char] -> Expr
    forall a. HasCallStack => [Char] -> a
    error ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Forced to evaluate untranslatable type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    eTyMsg), Maybe HWType -> HWType
    Void Maybe HWType
    forall a. Maybe a
    Nothing, Bool
    False), [])
          Just HWType
    hwTy -> case Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks Term
    e of
            (C.Var Id
    v,[],[TickInfo]
    _) -> do
              ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    v) Maybe Modifier
    forall a. Maybe a
    Nothing,HWType
    hwTy,Bool
    False),[])
            (C.Literal Literal
    l,[],[TickInfo]
    _) ->
              ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((Int -> Literal -> Expr
    mkLiteral Int
    iw Literal
    l,HWType
    hwTy,Bool
    True),[])

            (Prim PrimInfo
    pinfo,[Either Term Type]
    args,[TickInfo]
    ticks) -> [TickInfo]
    -> ([Declaration]
        -> NetlistMonad ((Expr, HWType, Bool), [Declaration]))
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (([Declaration]
      -> NetlistMonad ((Expr, HWType, Bool), [Declaration]))
     -> NetlistMonad ((Expr, HWType, Bool), [Declaration]))
    -> ([Declaration]
        -> NetlistMonad ((Expr, HWType, Bool), [Declaration]))
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a b. (a -> b) -> a -> b
    $ \[Declaration]
    tickDecls -> do
              (e',d) <- Bool
    -> Bool
    -> DeclarationType
    -> NetlistId
    -> PrimInfo
    -> [Either Term Type]
    -> [Declaration]
    -> NetlistMonad (Expr, [Declaration])
    mkPrimitive Bool
    True Bool
    False DeclarationType
    declType (Identifier -> Type -> NetlistId
    NetlistId Identifier
    bndr Type
    ty) PrimInfo
    pinfo [Either Term Type]
    args [Declaration]
    tickDecls
              case e' of
                (Identifier Identifier
    _ Maybe Modifier
    _) -> ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((Expr
    e',HWType
    hwTy,Bool
    False), [Declaration]
    d)
                Expr
    _                -> ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((Expr
    e',HWType
    hwTy,Term -> Bool
    isLiteral Term
    e), [Declaration]
    d)
            (Data DataCon
    dc, [Either Term Type]
    args,[TickInfo]
    _) -> do
              (exprN,dcDecls) <- HasCallStack =>
    DeclarationType
    -> [HWType]
    -> NetlistId
    -> DataCon
    -> [Term]
    -> NetlistMonad (Expr, [Declaration])
    DeclarationType
    -> [HWType]
    -> NetlistId
    -> DataCon
    -> [Term]
    -> NetlistMonad (Expr, [Declaration])
    mkDcApplication DeclarationType
    declType [HWType
    hwTy] (Identifier -> Type -> NetlistId
    NetlistId Identifier
    bndr Type
    ty) DataCon
    dc ([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args)
              return ((exprN,hwTy,isLiteral e),dcDecls)
            (Case Term
    scrut Type
    ty' [Alt
    alt],[],[TickInfo]
    _) -> do
              (projection,decls) <- DeclarationType
    -> Bool
    -> NetlistId
    -> Term
    -> Type
    -> Alt
    -> NetlistMonad (Expr, [Declaration])
    mkProjection DeclarationType
    declType Bool
    False (Identifier -> Type -> NetlistId
    NetlistId Identifier
    bndr Type
    ty) Term
    scrut Type
    ty' Alt
    alt
              return ((projection,hwTy,False),decls)
            (Let Bind Term
    _bnds Term
    _term, [], [TickInfo]
    _ticks) -> do
              (exprN, letDecls) <- HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType (Identifier -> Type -> NetlistId
    NetlistId Identifier
    bndr Type
    ty) Term
    e
              return ((exprN,hwTy,False),letDecls)
            (Term, [Either Term Type], [TickInfo])
    _ -> do
              let errMsg :: [Char]
    errMsg = [I.i|
                Forced to evaluate unexpected function argument:

                  #{eTyMsg}

                in 'mkArgument' for argument #{nArg} of blackbox #{show bbName}.
              |]

              ((Expr, HWType, Bool), [Declaration])
    -> NetlistMonad ((Expr, HWType, Bool), [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((Identifier -> Maybe Modifier -> Expr
    Identifier ([Char] -> Identifier
    forall a. HasCallStack => [Char] -> a
    error ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    errMsg)) Maybe Modifier
    forall a. Maybe a
    Nothing, HWType
    hwTy, Bool
    False), [])

        return ((e',t,l),d)

    -- | Extract a compiled primitive from a guarded primitive. Emit a warning if
    -- the guard wants to, or fail entirely.
    extractPrimWarnOrFail
      :: HasCallStack
      => TextS.Text
      -- ^ Name of primitive
      -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail :: HasCallStack => Text -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail Text
    nm = do
      prim <- Text
    -> HashMap Text GuardedCompiledPrimitive
    -> Maybe GuardedCompiledPrimitive
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMap.lookup Text
    nm (HashMap Text GuardedCompiledPrimitive
     -> Maybe GuardedCompiledPrimitive)
    -> NetlistMonad (HashMap Text GuardedCompiledPrimitive)
    -> NetlistMonad (Maybe GuardedCompiledPrimitive)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Getting
      (HashMap Text GuardedCompiledPrimitive)
      NetlistEnv
      (HashMap Text GuardedCompiledPrimitive)
    -> NetlistMonad (HashMap Text GuardedCompiledPrimitive)
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting
      (HashMap Text GuardedCompiledPrimitive)
      NetlistEnv
      (HashMap Text GuardedCompiledPrimitive)
    Getter NetlistEnv (HashMap Text GuardedCompiledPrimitive)
    primitives
      case prim of
        Just (HasBlackBox [PrimitiveWarning]
    warnings CompiledPrimitive
    compiledPrim) ->
          -- See if we need to warn the user
          if [PrimitiveWarning] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [PrimitiveWarning]
    warnings then CompiledPrimitive -> NetlistMonad CompiledPrimitive
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return CompiledPrimitive
    compiledPrim else [PrimitiveWarning]
    -> CompiledPrimitive -> NetlistMonad CompiledPrimitive
    go [PrimitiveWarning]
    warnings CompiledPrimitive
    compiledPrim
        Just GuardedCompiledPrimitive
    DontTranslate -> do
          -- We need to error because we encountered a primitive the user
          -- explicitly requested not to translate
          (_,sp) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    -> NetlistMonad (Identifier, SrcSpan)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    Lens' NetlistState (Identifier, SrcSpan)
    curCompNm
          let msg = $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Clash was forced to translate '" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    unpack Text
    nm
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "', but this value was marked with DontTranslate. Did you forget"
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " to include a blackbox for one of the constructs using this?"
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (if Bool
    debugIsOn then [Char]
    "\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> [Char]
    prettyCallStack CallStack
    HasCallStack => CallStack
    callStack [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\n\n" else [])
          throw (ClashException sp msg Nothing)
        Maybe GuardedCompiledPrimitive
    Nothing -> do
          -- Blackbox requested, but no blackbox found at all!
          (_,sp) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    -> NetlistMonad (Identifier, SrcSpan)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    Lens' NetlistState (Identifier, SrcSpan)
    curCompNm
          let msg = $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "No blackbox found for: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    unpack Text
    nm
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ". Did you forget to include directories containing "
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "primitives? You can use '-i/my/prim/dir' to achieve this."
                 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (if Bool
    debugIsOn then [Char]
    "\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> [Char]
    prettyCallStack CallStack
    HasCallStack => CallStack
    callStack [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\n\n" else [])
          throw (ClashException sp msg Nothing)
     where
      go
        :: [PrimitiveWarning]
        -> CompiledPrimitive
        -> NetlistMonad CompiledPrimitive

      go :: [PrimitiveWarning]
    -> CompiledPrimitive -> NetlistMonad CompiledPrimitive
    go ((WarnAlways [Char]
    warning):[PrimitiveWarning]
    ws) CompiledPrimitive
    cp = do
        opts <- Getting ClashOpts NetlistEnv ClashOpts -> NetlistMonad ClashOpts
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting ClashOpts NetlistEnv ClashOpts
    Getter NetlistEnv ClashOpts
    clashOpts
        let primWarn = ClashOpts -> Bool
    opt_primWarn ClashOpts
    opts
        seen <- Set.member nm <$> Lens.use seenPrimitives

        when (primWarn && not seen)
          $ liftIO
          $ warn opts
          $ "Dubious primitive instantiation for "
         ++ unpack nm
         ++ ": "
         ++ warning
         ++ " (disable with -fclash-no-prim-warn)"

        go ws cp

      go ((WarnNonSynthesizable [Char]
    warning):[PrimitiveWarning]
    ws) CompiledPrimitive
    cp = do
        isTB <- Getting Bool NetlistState Bool -> NetlistMonad Bool
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting Bool NetlistState Bool
    Lens' NetlistState Bool
    isTestBench
        if isTB then go ws cp else go ((WarnAlways warning):ws) cp

      go [] CompiledPrimitive
    cp = do
        (Set Text -> Identity (Set Text))
    -> NetlistState -> Identity NetlistState
    Lens' NetlistState (Set Text)
    seenPrimitives ((Set Text -> Identity (Set Text))
     -> NetlistState -> Identity NetlistState)
    -> (Set Text -> Set Text) -> NetlistMonad ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= Text -> Set Text -> Set Text
    forall a. Ord a => a -> Set a -> Set a
    Set.insert Text
    nm
        CompiledPrimitive -> NetlistMonad CompiledPrimitive
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return CompiledPrimitive
    cp

    mkPrimitive
      :: Bool
      -- ^ Put BlackBox expression in parenthesis
      -> Bool
      -- ^ Treat BlackBox expression as declaration
      -> DeclarationType
      -- ^ Are we concurrent or sequential?
      -> NetlistId
      -- ^ Id to assign the result to
      -> PrimInfo
      -- ^ Primitive info
      -> [Either Term Type]
      -- ^ Arguments
      -> [Declaration]
      -- ^ Tick declarations
      -> NetlistMonad (Expr,[Declaration])
    mkPrimitive :: Bool
    -> Bool
    -> DeclarationType
    -> NetlistId
    -> PrimInfo
    -> [Either Term Type]
    -> [Declaration]
    -> NetlistMonad (Expr, [Declaration])
    mkPrimitive Bool
    bbEParen Bool
    bbEasD DeclarationType
    declType NetlistId
    dst PrimInfo
    pInfo [Either Term Type]
    args [Declaration]
    tickDecls =
      CompiledPrimitive -> NetlistMonad (Expr, [Declaration])
    go (CompiledPrimitive -> NetlistMonad (Expr, [Declaration]))
    -> NetlistMonad CompiledPrimitive
    -> NetlistMonad (Expr, [Declaration])
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< HasCallStack => Text -> NetlistMonad CompiledPrimitive
    Text -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail (PrimInfo -> Text
    primName PrimInfo
    pInfo)
      where
        tys :: [Type]
    tys = NetlistId -> [Type]
    netlistTypes NetlistId
    dst
        ty :: Type
    ty = Type -> Maybe Type -> Type
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Type
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "mkPrimitive") ([Type] -> Maybe Type
    forall a. [a] -> Maybe a
    listToMaybe [Type]
    tys)
        assignTy :: Usage
    assignTy = DeclarationType -> Usage
    declTypeUsage DeclarationType
    declType

        go
          :: CompiledPrimitive
          -> NetlistMonad (Expr, [Declaration])
        go :: CompiledPrimitive -> NetlistMonad (Expr, [Declaration])
    go =
          \case
            P.BlackBoxHaskell Text
    bbName WorkInfo
    wf UsedArguments
    _usedArgs Bool
    multiResult BlackBoxFunctionName
    funcName (Int
    _fHash, BlackBoxFunction
    func) -> do
              bbFunRes <- BlackBoxFunction
    func Bool
    bbEasD (PrimInfo -> Text
    primName PrimInfo
    pInfo) [Either Term Type]
    args [Type]
    tys
              case bbFunRes of
                Left [Char]
    err -> do
                  -- Blackbox template function returned an error:
                  let err' :: [Char]
    err' = [[Char]] -> [Char]
    unwords [ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Could not create blackbox"
                                     , [Char]
    "template using", BlackBoxFunctionName -> [Char]
    forall a. Show a => a -> [Char]
    show BlackBoxFunctionName
    funcName, [Char]
    "for"
                                     , Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    bbName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ".", [Char]
    "Function reported: \n\n"
                                     , [Char]
    err ]
                  (_,sp) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    -> NetlistMonad (Identifier, SrcSpan)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
    Lens' NetlistState (Identifier, SrcSpan)
    curCompNm
                  throw (ClashException sp err' Nothing)
                Right (BlackBoxMeta {[BlackBoxTemplate]
    [(Int, Int)]
    [((Text, Text), BlackBox)]
    [BlackBox]
    Usage
    TemplateKind
    RenderVoid
    bbOutputUsage :: Usage
    bbKind :: TemplateKind
    bbLibrary :: [BlackBoxTemplate]
    bbImports :: [BlackBoxTemplate]
    bbFunctionPlurality :: [(Int, Int)]
    bbIncludes :: [((Text, Text), BlackBox)]
    bbRenderVoid :: RenderVoid
    bbResultNames :: [BlackBox]
    bbResultInits :: [BlackBox]
    bbResultInits :: BlackBoxMeta -> [BlackBox]
    bbResultNames :: BlackBoxMeta -> [BlackBox]
    bbRenderVoid :: BlackBoxMeta -> RenderVoid
    bbIncludes :: BlackBoxMeta -> [((Text, Text), BlackBox)]
    bbFunctionPlurality :: BlackBoxMeta -> [(Int, Int)]
    bbImports :: BlackBoxMeta -> [BlackBoxTemplate]
    bbLibrary :: BlackBoxMeta -> [BlackBoxTemplate]
    bbKind :: BlackBoxMeta -> TemplateKind
    bbOutputUsage :: BlackBoxMeta -> Usage
    ..}, BlackBox
    bbTemplate) ->
                  -- Blackbox template generation successful. Rerun 'go', but this time
                  -- around with a 'normal' @BlackBox@
                  CompiledPrimitive -> NetlistMonad (Expr, [Declaration])
    go (Text
    -> WorkInfo
    -> RenderVoid
    -> Bool
    -> TemplateKind
    -> ()
    -> Usage
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [(Int, Int)]
    -> [((Text, Text), BlackBox)]
    -> [BlackBox]
    -> [BlackBox]
    -> BlackBox
    -> CompiledPrimitive
    forall a b c d.
    Text
    -> WorkInfo
    -> RenderVoid
    -> Bool
    -> TemplateKind
    -> c
    -> Usage
    -> [a]
    -> [a]
    -> [(Int, Int)]
    -> [((Text, Text), b)]
    -> [b]
    -> [b]
    -> b
    -> Primitive a b c d
    P.BlackBox
                        Text
    bbName WorkInfo
    wf RenderVoid
    bbRenderVoid Bool
    multiResult TemplateKind
    bbKind () Usage
    bbOutputUsage
                        [BlackBoxTemplate]
    bbLibrary [BlackBoxTemplate]
    bbImports [(Int, Int)]
    bbFunctionPlurality [((Text, Text), BlackBox)]
    bbIncludes
                        [BlackBox]
    bbResultNames [BlackBox]
    bbResultInits BlackBox
    bbTemplate)
            -- See 'setupMultiResultPrim' in "Clash.Normalize.Transformations":
            P.BlackBox {name :: forall a b c d. Primitive a b c d -> Text
    name=Text
    "c$multiPrimSelect"} ->
              (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Expr
    Noop, [])
            p :: CompiledPrimitive
    p@P.BlackBox {multiResult :: forall a b c d. Primitive a b c d -> Bool
    multiResult=Bool
    True, Text
    name :: forall a b c d. Primitive a b c d -> Text
    name :: Text
    name, BlackBox
    template :: BlackBox
    template :: forall a b c d. Primitive a b c d -> b
    template} -> do
              -- Multi result primitives assign their results to signals
              -- provided as arguments. Hence, we ignore any declarations
              -- from 'resBndr1'.
              tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
              let (args1, resArgs) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args
              (bbCtx, ctxDcls) <- mkBlackBoxContext (primName pInfo) declType resArgs args1
              (templ, templDecl) <- prepareBlackBox name template bbCtx
              let bbDecl = Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    N.BlackBoxD Text
    name (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    libraries CompiledPrimitive
    p) (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    imports CompiledPrimitive
    p) (CompiledPrimitive -> [((Text, Text), BlackBox)]
    forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes CompiledPrimitive
    p) BlackBox
    templ BlackBoxContext
    bbCtx
              return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl])
            p :: CompiledPrimitive
    p@(P.BlackBox {BlackBox
    template :: forall a b c d. Primitive a b c d -> b
    template :: BlackBox
    template, name :: forall a b c d. Primitive a b c d -> Text
    name=Text
    pNm, TemplateKind
    kind :: TemplateKind
    kind :: forall a b c d. Primitive a b c d -> TemplateKind
    kind,Usage
    outputUsage :: Usage
    outputUsage :: forall a b c d. Primitive a b c d -> Usage
    outputUsage}) ->
              case TemplateKind
    kind of
                TemplateKind
    TDecl -> do
                  resM <- HasCallStack =>
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    resBndr1 Bool
    True NetlistId
    dst
                  case resM of
                    Just (Id
    dst',Identifier
    dstNm,[Declaration]
    dstDecl) -> do
                      (bbCtx,ctxDcls)   <- HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext (PrimInfo -> Text
    primName PrimInfo
    pInfo) DeclarationType
    declType [Id
    dst'] [Either Term Type]
    args
                      (templ,templDecl) <- prepareBlackBox pNm template bbCtx
                      let bbDecl = Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    N.BlackBoxD Text
    pNm (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    libraries CompiledPrimitive
    p) (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    imports CompiledPrimitive
    p)
                                               (CompiledPrimitive -> [((Text, Text), BlackBox)]
    forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes CompiledPrimitive
    p) BlackBox
    templ BlackBoxContext
    bbCtx
                      declareUse outputUsage dstNm
                      return (Identifier dstNm Nothing,dstDecl ++ ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl])

                    -- Render declarations as a Noop when requested
                    Maybe (Id, Identifier, [Declaration])
    Nothing | RenderVoid
    RenderVoid <- CompiledPrimitive -> RenderVoid
    forall a b c d. Primitive a b c d -> RenderVoid
    renderVoid CompiledPrimitive
    p -> do
                      -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists
                      let dst1 :: Id
    dst1 = Type -> TmName -> Id
    mkLocalId Type
    ty (Text -> Unique -> TmName
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName Text
    "__VOID_TDECL_NOOP__" Unique
    0)
                      (bbCtx,ctxDcls) <- HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext (PrimInfo -> Text
    primName PrimInfo
    pInfo) DeclarationType
    declType [Id
    dst1] [Either Term Type]
    args
                      (templ,templDecl) <- prepareBlackBox pNm template bbCtx
                      let bbDecl = Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    N.BlackBoxD Text
    pNm (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    libraries CompiledPrimitive
    p) (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    imports CompiledPrimitive
    p)
                                               (CompiledPrimitive -> [((Text, Text), BlackBox)]
    forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes CompiledPrimitive
    p) BlackBox
    templ BlackBoxContext
    bbCtx
                      return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl])

                    -- Otherwise don't render them
                    Maybe (Id, Identifier, [Declaration])
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop,[])
                TemplateKind
    TExpr -> do
                  if Bool
    bbEasD
                    then do
                      resM <- HasCallStack =>
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    resBndr1 Bool
    True NetlistId
    dst
                      case resM of
                        Just (Id
    dst',Identifier
    dstNm,[Declaration]
    dstDecl) -> do
                          (bbCtx,ctxDcls) <- HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext (PrimInfo -> Text
    primName PrimInfo
    pInfo) DeclarationType
    declType [Id
    dst'] [Either Term Type]
    args
                          (bbTempl,templDecl) <- prepareBlackBox pNm template bbCtx
                          let bbE =  Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Bool
    -> Expr
    BlackBoxE Text
    pNm (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    libraries CompiledPrimitive
    p) (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    imports CompiledPrimitive
    p) (CompiledPrimitive -> [((Text, Text), BlackBox)]
    forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes CompiledPrimitive
    p) BlackBox
    bbTempl BlackBoxContext
    bbCtx Bool
    bbEParen
                          tmpAssgn <- case declType of
                            DeclarationType
    Concurrent -> HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    dstNm Expr
    bbE
                            DeclarationType
    Sequential -> HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    dstNm Expr
    bbE
                          return (Identifier dstNm Nothing, dstDecl ++ ctxDcls ++ templDecl ++ [tmpAssgn])

                        -- Render expression as a Noop when requested
                        Maybe (Id, Identifier, [Declaration])
    Nothing | RenderVoid
    RenderVoid <- CompiledPrimitive -> RenderVoid
    forall a b c d. Primitive a b c d -> RenderVoid
    renderVoid CompiledPrimitive
    p -> do
                          -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists
                          let dst1 :: Id
    dst1 = Type -> TmName -> Id
    mkLocalId Type
    ty (Text -> Unique -> TmName
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName Text
    "__VOID_TEXPRD_NOOP__" Unique
    0)
                          (bbCtx,ctxDcls) <- HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext (PrimInfo -> Text
    primName PrimInfo
    pInfo) DeclarationType
    declType [Id
    dst1] [Either Term Type]
    args
                          (templ,templDecl) <- prepareBlackBox pNm template bbCtx
                          let bbDecl = Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    N.BlackBoxD Text
    pNm (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    libraries CompiledPrimitive
    p) (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    imports CompiledPrimitive
    p)
                                                   (CompiledPrimitive -> [((Text, Text), BlackBox)]
    forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes CompiledPrimitive
    p) BlackBox
    templ BlackBoxContext
    bbCtx
                          return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl])

                        -- Otherwise don't render them
                        Maybe (Id, Identifier, [Declaration])
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "__VOID_TEXPRD__") Maybe Modifier
    forall a. Maybe a
    Nothing,[])
                    else do
                      resM <- HasCallStack =>
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    resBndr1 Bool
    False NetlistId
    dst
                      case resM of
                        Just (Id
    dst',Identifier
    _,[Declaration]
    _) -> do
                          (bbCtx,ctxDcls)      <- HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext (PrimInfo -> Text
    primName PrimInfo
    pInfo) DeclarationType
    declType [Id
    dst'] [Either Term Type]
    args
                          (bbTempl,templDecl0) <- prepareBlackBox pNm template bbCtx
                          let templDecl1 = case PrimInfo -> Text
    primName PrimInfo
    pInfo of
                                Text
    "Clash.Sized.Internal.BitVector.fromInteger#"
                                  | [N.Literal Maybe (HWType, Int)
    _ (NumLit Integer
    _), N.Literal Maybe (HWType, Int)
    _ Literal
    _, N.Literal Maybe (HWType, Int)
    _ Literal
    _] <- BlackBoxContext -> [Expr]
    extractLiterals BlackBoxContext
    bbCtx -> []
                                Text
    "Clash.Sized.Internal.BitVector.fromInteger##"
                                  | [N.Literal Maybe (HWType, Int)
    _ Literal
    _, N.Literal Maybe (HWType, Int)
    _ Literal
    _] <- BlackBoxContext -> [Expr]
    extractLiterals BlackBoxContext
    bbCtx -> []
                                Text
    "Clash.Sized.Internal.Index.fromInteger#"
                                  | [N.Literal Maybe (HWType, Int)
    _ (NumLit Integer
    _), N.Literal Maybe (HWType, Int)
    _ Literal
    _] <- BlackBoxContext -> [Expr]
    extractLiterals BlackBoxContext
    bbCtx -> []
                                Text
    "Clash.Sized.Internal.Signed.fromInteger#"
                                  | [N.Literal Maybe (HWType, Int)
    _ (NumLit Integer
    _), N.Literal Maybe (HWType, Int)
    _ Literal
    _] <- BlackBoxContext -> [Expr]
    extractLiterals BlackBoxContext
    bbCtx -> []
                                Text
    "Clash.Sized.Internal.Unsigned.fromInteger#"
                                  | [N.Literal Maybe (HWType, Int)
    _ (NumLit Integer
    _), N.Literal Maybe (HWType, Int)
    _ Literal
    _] <- BlackBoxContext -> [Expr]
    extractLiterals BlackBoxContext
    bbCtx -> []
                                Text
    _ -> [Declaration]
    templDecl0
                          return (BlackBoxE pNm (libraries p) (imports p) (includes p) bbTempl bbCtx bbEParen,ctxDcls ++ templDecl1)
                        -- Render expression as a Noop when requested
                        Maybe (Id, Identifier, [Declaration])
    Nothing | RenderVoid
    RenderVoid <- CompiledPrimitive -> RenderVoid
    forall a b c d. Primitive a b c d -> RenderVoid
    renderVoid CompiledPrimitive
    p -> do
                          -- TODO: We should probably 'mkBlackBoxContext' to accept empty lists
                          let dst1 :: Id
    dst1 = Type -> TmName -> Id
    mkLocalId Type
    ty (Text -> Unique -> TmName
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName Text
    "__VOID_TEXPRE_NOOP__" Unique
    0)
                          (bbCtx,ctxDcls) <- HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext (PrimInfo -> Text
    primName PrimInfo
    pInfo) DeclarationType
    declType [Id
    dst1] [Either Term Type]
    args
                          (templ,templDecl) <- prepareBlackBox pNm template bbCtx
                          let bbDecl = Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    N.BlackBoxD Text
    pNm (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    libraries CompiledPrimitive
    p) (CompiledPrimitive -> [BlackBoxTemplate]
    forall a b c d. Primitive a b c d -> [a]
    imports CompiledPrimitive
    p)
                                                   (CompiledPrimitive -> [((Text, Text), BlackBox)]
    forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes CompiledPrimitive
    p) BlackBox
    templ BlackBoxContext
    bbCtx
                          return (Noop, ctxDcls ++ templDecl ++ tickDecls ++ [bbDecl])

                        -- Otherwise don't render them
                        Maybe (Id, Identifier, [Declaration])
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "__VOID__") Maybe Modifier
    forall a. Maybe a
    Nothing,[])
            P.Primitive Text
    pNm WorkInfo
    _ Text
    _
              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Prim.tagToEnum#" -> do
                  hwTy <- [Char] -> Type -> NetlistMonad HWType
    N.unsafeCoreTypeToHWTypeM' $(curLoc) Type
    ty
                  case args of
                    [Right (ConstTy (TyCon TyConName
    tcN)), Left (C.Literal (IntLiteral Integer
    i))] -> do
                      tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
                      let dcs = TyCon -> [DataCon]
    tyConDataCons (TyConName -> TyConMap -> TyCon
    forall a b. Uniquable a => a -> UniqMap b -> b
    UniqMap.find TyConName
    tcN TyConMap
    tcm)
                          dc  = [DataCon]
    dcs [DataCon] -> Int -> DataCon
    forall a. HasCallStack => [a] -> Int -> a
    !! Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    i
                      (exprN,dcDecls) <- mkDcApplication declType [hwTy] dst dc []
                      return (exprN,dcDecls)
                    [Right Type
    _, Left Term
    scrut] -> do
                      tcm     <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
                      let scrutTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    scrut
                      (scrutExpr,scrutDecls) <-
                        mkExpr False declType (NetlistId (Id.unsafeMake "c$tte_rhs") scrutTy) scrut
                      case scrutExpr of
                        Identifier Identifier
    id_ Maybe Modifier
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Either Identifier Identifier -> Expr
    DataTag HWType
    hwTy (Identifier -> Either Identifier Identifier
    forall a b. a -> Either a b
    Left Identifier
    id_),[Declaration]
    scrutDecls)
                        Expr
    _ -> do
                          scrutHTy <- [Char] -> Type -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' $(curLoc) Type
    scrutTy
                          tmpRhs <- Id.make "c$tte_rhs"
                          netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr
                          return (DataTag hwTy (Left tmpRhs), netDecl ++ scrutDecls)
                    [Either Term Type]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad (Expr, [Declaration]))
    -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "tagToEnum: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show ((Either Term Type -> [Char]) -> [Either Term Type] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Term -> [Char]) -> (Type -> [Char]) -> Either Term Type -> [Char]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr) [Either Term Type]
    args)
              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Prim.dataToTag#" -> case [Either Term Type]
    args of
                  [Right Type
    _,Left (Data DataCon
    dc)] -> do
                    iw <- Getting Int NetlistEnv Int -> NetlistMonad Int
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting Int NetlistEnv Int
    Getter NetlistEnv Int
    intWidth
                    return (N.Literal (Just (Signed iw,iw)) (NumLit $ toInteger $ dcTag dc - 1),[])
                  [Right Type
    _,Left Term
    scrut] -> do
                    tcm      <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
                    let scrutTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    scrut
                    scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy
                    (scrutExpr,scrutDecls) <-
                      mkExpr False declType (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut
                    case scrutExpr of
                      Identifier Identifier
    id_ Maybe Modifier
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Either Identifier Identifier -> Expr
    DataTag HWType
    scrutHTy (Identifier -> Either Identifier Identifier
    forall a b. b -> Either a b
    Right Identifier
    id_),[Declaration]
    scrutDecls)
                      Expr
    _ -> do
                        tmpRhs <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "c$dtt_rhs"
                        netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr
                        return (DataTag scrutHTy (Right tmpRhs),netDecl ++ scrutDecls)
                  [Either Term Type]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad (Expr, [Declaration]))
    -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "dataToTag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show ((Either Term Type -> [Char]) -> [Either Term Type] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Term -> [Char]) -> (Type -> [Char]) -> Either Term Type -> [Char]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr) [Either Term Type]
    args)

              | Text
    pNm Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    `elem`
                [Text
    "GHC.Prim.dataToTagSmall#", Text
    "GHC.Prim.dataToTagLarge#"] -> case [Either Term Type]
    args of
                  [Right Type
    _, Right Type
    _,Left (Data DataCon
    dc)] -> do
                    iw <- Getting Int NetlistEnv Int -> NetlistMonad Int
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting Int NetlistEnv Int
    Getter NetlistEnv Int
    intWidth
                    return (N.Literal (Just (Signed iw,iw)) (NumLit $ toInteger $ dcTag dc - 1),[])
                  [Right Type
    _, Right Type
    _,Left Term
    scrut] -> do
                    tcm      <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
                    let scrutTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    scrut
                    scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy
                    (scrutExpr,scrutDecls) <-
                      mkExpr False declType (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut
                    case scrutExpr of
                      Identifier Identifier
    id_ Maybe Modifier
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Either Identifier Identifier -> Expr
    DataTag HWType
    scrutHTy (Identifier -> Either Identifier Identifier
    forall a b. b -> Either a b
    Right Identifier
    id_),[Declaration]
    scrutDecls)
                      Expr
    _ -> do
                        tmpRhs <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "c$dtt_rhs"
                        netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr
                        return (DataTag scrutHTy (Right tmpRhs),netDecl ++ scrutDecls)
                  [Either Term Type]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad (Expr, [Declaration]))
    -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "dataToTag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show ((Either Term Type -> [Char]) -> [Either Term Type] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Term -> [Char]) -> (Type -> [Char]) -> Either Term Type -> [Char]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr) [Either Term Type]
    args)

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.mealyIO" -> do
                  resM <- HasCallStack =>
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    resBndr1 Bool
    True NetlistId
    dst
                  case resM of
                    Just (Id
    _,Identifier
    dstNm,[Declaration]
    dstDecl) -> do
                      tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
                      mealyDecls <- collectMealy dstNm dst tcm (lefts args)
                      return (Noop, dstDecl ++ mealyDecls)
                    Maybe (Id, Identifier, [Declaration])
    Nothing -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop,[])

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.bindSimIO#" -> do
                  (expr,decls) <- NetlistId -> [Term] -> NetlistMonad (Expr, [Declaration])
    collectBindIO NetlistId
    dst ([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args)
                  resM <- resBndr True dst
                  case resM of
                    Just ([Id]
    _,[Identifier]
    dstNms,[Declaration]
    dstDecl) -> case Expr
    expr of
                      Expr
    Noop ->
                        (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop,[Declaration]
    decls)
                      Expr
    _ -> case [Identifier]
    dstNms of
                        [Identifier
    dstNm] -> do
                          Usage -> Identifier -> NetlistMonad ()
    declareUse (Blocking -> Usage
    Proc Blocking
    Blocking) Identifier
    dstNm
                          assn <- HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    dstNm Expr
    expr
                          return ( Identifier dstNm Nothing
                                 , dstDecl ++ decls ++ [assn])
                        [Identifier]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad (Expr, [Declaration]))
    -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "bindSimIO: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Maybe ([Id], [Identifier], [Declaration]) -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe ([Id], [Identifier], [Declaration])
    resM
                    Maybe ([Id], [Identifier], [Declaration])
    _ ->
                      (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop,[Declaration]
    decls)

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.apSimIO#" -> do
                  NetlistId -> [Term] -> [Term] -> NetlistMonad (Expr, [Declaration])
    collectAppIO NetlistId
    dst ([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args) []

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.fmapSimIO#" -> do
                  resM <- HasCallStack =>
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    resBndr1 Bool
    True NetlistId
    dst
                  case resM of
                    Just (Id
    _,Identifier
    dstNm,[Declaration]
    dstDecl) -> case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                      (Term
    fun0:Term
    arg0:[Term]
    _) -> do
                        tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
                        let arg1 = TyConMap -> Term -> Term
    unSimIO TyConMap
    tcm Term
    arg0
                            fun1 = case Term
    fun0 of
                              Lam Id
    b Term
    bE ->
                                let is0 :: InScopeSet
    is0 = UniqMap (Var Any) -> InScopeSet
    mkInScopeSet (Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    fun0)
                                    subst :: Subst
    subst = Subst -> Id -> Term -> Subst
    extendIdSubst (InScopeSet -> Subst
    mkSubst InScopeSet
    is0) Id
    b Term
    arg1
                                in  HasCallStack => Doc () -> Subst -> Term -> Term
    Doc () -> Subst -> Term -> Term
    substTm Doc ()
    "mkPrimitive.fmapSimIO" Subst
    subst Term
    bE
                              Term
    _ -> Term -> [Either Term Type] -> Term
    mkApps Term
    fun0 [Term -> Either Term Type
    forall a b. a -> Either a b
    Left Term
    arg1]
                        (expr,bindDecls) <- mkExpr False Sequential dst fun1
                        assn <- case expr of
                                  Expr
    Noop -> [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
                                  Expr
    _ -> do Usage -> Identifier -> NetlistMonad ()
    declareUse (Blocking -> Usage
    Proc Blocking
    Blocking) Identifier
    dstNm
                                          assn <- HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    dstNm Expr
    expr
                                          pure [assn]
                        return (Identifier dstNm Nothing, dstDecl ++ bindDecls ++ assn)
                      [Term]
    args1 -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error: fmapSimIO# has insufficient arguments"
                                      [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    args1)
                    Maybe (Id, Identifier, [Declaration])
    Nothing -> case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                      (Term
    _:Term
    arg0:[Term]
    _) -> do
                        (_,bindDecls) <- HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    True DeclarationType
    Sequential NetlistId
    dst Term
    arg0
                        return (Noop, bindDecls)
                      [Term]
    args1 -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error: fmapSimIO# has insufficient arguments"
                                      [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    args1)

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.unSimIO#" ->
                  case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    Sequential NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.pureSimIO#" -> do
                  (expr,decls) <- case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    Sequential NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"
                  resM <- resBndr True dst
                  case resM of
                    Just ([Id]
    _,[Identifier]
    dstNms,[Declaration]
    dstDecl) -> case Expr
    expr of
                      Expr
    Noop ->
                        (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop,[Declaration]
    decls)
                      Expr
    _ -> case [Identifier]
    dstNms of
                        [Identifier
    dstNm] -> do
                          Usage -> Identifier -> NetlistMonad ()
    declareUse (Blocking -> Usage
    Proc Blocking
    Blocking) Identifier
    dstNm
                          assn <- HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    dstNm Expr
    expr
                          return ( Identifier dstNm Nothing
                                 , dstDecl ++ decls ++ [assn])
                        [Identifier]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"
                    Maybe ([Id], [Identifier], [Declaration])
    _ ->
                      (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop,[Declaration]
    decls)

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.IS" -> do
                  (expr,decls) <- case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"
                  iw <- Lens.view intWidth
                  return (N.DataCon (Signed iw) (DC (Void Nothing,-1)) [expr],decls)

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.IP" -> do
                  (expr,decls) <- case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"
                  case expr of
                    N.Literal Maybe (HWType, Int)
    Nothing (NumLit Integer
    _) -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    expr,[Declaration]
    decls)
                    Expr
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "non-constant ByteArray# not supported"

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.IN" -> do
                  (expr,decls) <- case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"
                  case expr of
                    N.Literal Maybe (HWType, Int)
    Nothing (NumLit Integer
    i) ->
                      (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Maybe (HWType, Int) -> Literal -> Expr
    N.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Integer -> Literal
    NumLit (Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    i)),[Declaration]
    decls)
                    Expr
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "non-constant ByteArray# not supported"

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Natural.NS" -> do
                  (expr,decls) <- case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"
                  iw <- Lens.view intWidth
                  return (N.DataCon (Unsigned iw) (DC (Void Nothing,-1)) [expr],decls)

              | Text
    pNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.NB" -> do
                  (expr,decls) <- case [Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args of
                    (Term
    arg:[Term]
    _) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType NetlistId
    dst Term
    arg
                    [Term]
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient arguments"
                  case expr of
                    N.Literal Maybe (HWType, Int)
    Nothing (NumLit Integer
    _) -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    expr,[Declaration]
    decls)
                    Expr
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "non-constant ByteArray# not supported"

              | Bool
    otherwise ->
                  (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Bool
    -> Expr
    BlackBoxE Text
    "" [] [] []
                            (BlackBoxTemplate -> BlackBox
    BBTemplate [Text -> Element
    Text (Text -> Element) -> Text -> Element
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat [Text
    "NO_TRANSLATION_FOR:",Text -> Text
    fromStrict Text
    pNm]])
                            (Text -> BlackBoxContext
    emptyBBContext Text
    pNm) Bool
    False,[])

        -- Do we need to create a new identifier to assign the result?
        --
        -- CoreId: No, this is an original LHS of a let-binder, and already has a
        --         corresponding NetDecl; unlike NetlistIds, it is not already
        --         assigned, it will be assigned by the BlackBox/Primitive.
        --
        -- NetlistId: This is a derived (either from an CoreId or other NetlistId)
        --            identifier created in the NetlistMonad that's already being
        --            used in an assignment, i.e. we cannot assign it again.
        --
        --            So if it is a declaration BlackBox (indicated by 'mkDec'),
        --            we will have to create a new NetlistId, create a NetDecl for
        --            it, and use this new NetlistId for the assignment inside the
        --            declaration BlackBox
        --
        -- MultiId: This is like a CoreId, but it's split over multiple identifiers
        --          because it was originally of a product type where the element
        --          types should not be part of an aggregate type in the generated
        --          HDL (e.g. Clocks should not be part of an aggregate, because
        --          tools like verilator don't like it)
        resBndr
          :: Bool
          -- Do we need to create and declare a new identifier in case we're given
          -- a NetlistId?
          -> NetlistId
          -- CoreId/NetlistId/MultiId
          -> NetlistMonad (Maybe ([Id],[Identifier],[Declaration]))
          -- Nothing when the binder would have type `Void`
        resBndr :: Bool
    -> NetlistId
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    resBndr Bool
    mkDec NetlistId
    dst' = do
          resHwTy <- case [Type]
    tys of
            (Type
    ty1:[Type]
    _) -> [Char] -> Type -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' $(curLoc) Type
    ty1
            [Type]
    _ -> [Char] -> NetlistMonad HWType
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient types"
          if isVoid resHwTy then
            pure Nothing
          else
            case dst' of
              NetlistId Identifier
    dstL Type
    ty' -> case Bool
    mkDec of
                Bool
    False -> do
                  -- TODO: check that it's okay to use `mkUnsafeSystemName`
                  let nm' :: Name a
    nm' = Text -> Unique -> Name a
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName (Identifier -> Text
    Id.toText Identifier
    dstL) Unique
    0
                      id_ :: Id
    id_ = Type -> TmName -> Id
    mkLocalId Type
    ty' TmName
    forall {a}. Name a
    nm'
                  Maybe ([Id], [Identifier], [Declaration])
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (([Id], [Identifier], [Declaration])
    -> Maybe ([Id], [Identifier], [Declaration])
    forall a. a -> Maybe a
    Just ([Id
    id_],[Identifier
    dstL],[]))
                Bool
    True -> do
                  nm2 <- Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix Identifier
    dstL Text
    "res"
                  -- TODO: check that it's okay to use `mkUnsafeInternalName`
                  let nm3 = Text -> Unique -> Name a
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName (Identifier -> Text
    Id.toText Identifier
    nm2) Unique
    0
                      id_ = Type -> TmName -> Id
    mkLocalId Type
    ty TmName
    forall {a}. Name a
    nm3

                  idDeclM <- mkNetDecl (id_, mkApps (Prim pInfo) args)
                  case idDeclM of
                    [] -> Maybe ([Id], [Identifier], [Declaration])
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe ([Id], [Identifier], [Declaration])
    forall a. Maybe a
    Nothing
                    [Declaration
    idDecl] -> Maybe ([Id], [Identifier], [Declaration])
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (([Id], [Identifier], [Declaration])
    -> Maybe ([Id], [Identifier], [Declaration])
    forall a. a -> Maybe a
    Just ([Id
    id_],[Identifier
    nm2],[Declaration
    idDecl]))
                    [Declaration]
    ids -> [Char] -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    forall a. HasCallStack => [Char] -> a
    error [I.i|
                      Unexpected nested use of multi result primitive. Ids:

                        #{show ids}

                      Multi primitive should only appear on the RHS of a
                      let-binding. Please report this as a bug.
                    |]

              CoreId Id
    dstR ->
                Maybe ([Id], [Identifier], [Declaration])
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (([Id], [Identifier], [Declaration])
    -> Maybe ([Id], [Identifier], [Declaration])
    forall a. a -> Maybe a
    Just ([Id
    dstR], [HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    dstR], []))
              MultiId [Id]
    ids ->
                Maybe ([Id], [Identifier], [Declaration])
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (([Id], [Identifier], [Declaration])
    -> Maybe ([Id], [Identifier], [Declaration])
    forall a. a -> Maybe a
    Just ([Id]
    ids, (Id -> Identifier) -> [Id] -> [Identifier]
    forall a b. (a -> b) -> [a] -> [b]
    map HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId [Id]
    ids, []))

        -- Like resBndr, but fails on MultiId
        resBndr1
          :: HasCallStack
          => Bool
          -> NetlistId
          -> NetlistMonad (Maybe (Id,Identifier,[Declaration]))
        resBndr1 :: HasCallStack =>
    Bool
    -> NetlistId
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    resBndr1 Bool
    mkDec NetlistId
    dst' = Bool
    -> NetlistId
    -> NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    resBndr Bool
    mkDec NetlistId
    dst' NetlistMonad (Maybe ([Id], [Identifier], [Declaration]))
    -> (Maybe ([Id], [Identifier], [Declaration])
        -> NetlistMonad (Maybe (Id, Identifier, [Declaration])))
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    forall a b.
    NetlistMonad a -> (a -> NetlistMonad b) -> NetlistMonad b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Maybe ([Id], [Identifier], [Declaration])
    Nothing -> Maybe (Id, Identifier, [Declaration])
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe (Id, Identifier, [Declaration])
    forall a. Maybe a
    Nothing
          Just ([Id
    id_],[Identifier
    nm_],[Declaration]
    decls) -> Maybe (Id, Identifier, [Declaration])
    -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((Id, Identifier, [Declaration])
    -> Maybe (Id, Identifier, [Declaration])
    forall a. a -> Maybe a
    Just (Id
    id_,Identifier
    nm_,[Declaration]
    decls))
          Maybe ([Id], [Identifier], [Declaration])
    _ -> [Char] -> NetlistMonad (Maybe (Id, Identifier, [Declaration]))
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"

    -- | Turn a 'mealyIO' expression into a two sequential processes, one "initial"
    -- process for the starting state, and one clocked sequential process.
    collectMealy
      :: HasCallStack
      => Identifier
      -- ^ Identifier to assign the final result to
      -> NetlistId
      -- ^ Id to assign the final result to
      -> TyConMap
      -> [Term]
      -- ^ The arguments to 'mealyIO'
      -> NetlistMonad [Declaration]
    collectMealy :: HasCallStack =>
    Identifier
    -> NetlistId -> TyConMap -> [Term] -> NetlistMonad [Declaration]
    collectMealy Identifier
    dstNm NetlistId
    dst TyConMap
    tcm (Term
    kd:Term
    clk:Term
    mealyFun:Term
    mealyInit:Term
    mealyIn:[Term]
    _) = do
      let ([Either Id TyVar] -> [Id]
    forall a b. [Either a b] -> [a]
    lefts -> [Id]
    args0,Term
    res0) = Term -> ([Either Id TyVar], Term)
    collectBndrs Term
    mealyFun
          is0 :: InScopeSet
    is0 = UniqMap (Var Any) -> InScopeSet
    mkInScopeSet (Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    res0 UniqMap (Var Any) -> UniqMap (Var Any) -> UniqMap (Var Any)
    forall a. Semigroup a => a -> a -> a
    <>
                              Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    mealyInit UniqMap (Var Any) -> UniqMap (Var Any) -> UniqMap (Var Any)
    forall a. Semigroup a => a -> a -> a
    <>
                              Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    mealyIn)
          -- Given that we're creating a sequential list of statements from the
          -- let-bindings, make sure that everything is inverse topologically sorted
          ([LetBinding]
    bs,Id
    res) = case Term
    res0 of
            Letrec [LetBinding]
    bsU Term
    e | let bsN :: [LetBinding]
    bsN = HasCallStack => [LetBinding] -> [LetBinding]
    [LetBinding] -> [LetBinding]
    inverseTopSortLetBindings [LetBinding]
    bsU -> case Term
    e of
              C.Var Id
    resN -> ([LetBinding]
    bsN,Id
    resN)
              Term
    _ ->
                let u :: Id
    u = case NetlistId
    dst of
                          CoreId Id
    u0 -> Id
    u0
                          NetlistId
    _ -> InScopeSet -> Id -> Id
    forall a. (Uniquable a, ClashPretty a) => InScopeSet -> a -> a
    uniqAway InScopeSet
    is0
                                (Type -> TmName -> Id
    mkLocalId (TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    e)
                                            (Text -> Unique -> TmName
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName Text
    "mealyres" Unique
    0))
                in  ([LetBinding]
    bsN [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. [a] -> [a] -> [a]
    ++ [(Id
    u,Term
    e)], Id
    u)
            Term
    e ->
              let u :: Id
    u = case NetlistId
    dst of
                        CoreId Id
    u0 -> Id
    u0
                        NetlistId
    _ -> InScopeSet -> Id -> Id
    forall a. (Uniquable a, ClashPretty a) => InScopeSet -> a -> a
    uniqAway InScopeSet
    is0
                               (Type -> TmName -> Id
    mkLocalId (TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    e)
                                          (Text -> Unique -> TmName
    forall a. Text -> Unique -> Name a
    mkUnsafeSystemName Text
    "mealyres" Unique
    0))
              in  ([(Id
    u,Term
    e)], Id
    u)
    #if __GLASGOW_HASKELL__ >= 900
          args1 :: [Id]
    args1 = [Id]
    args0
    #else
          -- Drop the 'State# World' argument
          args1 = init args0
    #endif
          -- Take into account that the state argument is split over multiple
          -- binders because it contained types that are not allowed to occur in
          -- a HDL aggregate type
          mealyInitLength :: Int
    mealyInitLength = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length (TyConMap -> [Type] -> [Type]
    splitShouldSplit TyConMap
    tcm [TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    mealyInit])
          ([Id]
    sArgs,[Id]
    iArgs) = Int -> [Id] -> ([Id], [Id])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    mealyInitLength [Id]
    args1
      -- Give all binders a unique name
      let sBindings :: [LetBinding]
    sBindings = (Id -> LetBinding) -> [Id] -> [LetBinding]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Term
    mealyInit) [Id]
    sArgs [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. [a] -> [a] -> [a]
    ++ (Id -> LetBinding) -> [Id] -> [LetBinding]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Term
    mealyIn) [Id]
    iArgs [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. [a] -> [a] -> [a]
    ++ [LetBinding]
    bs
      normE <- HasCallStack =>
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    mkUniqueNormalized InScopeSet
    is0 Maybe (Maybe TopEntity)
    forall a. Maybe a
    Nothing ([], [LetBinding]
    sBindings, Id
    res)
      case normE of
        -- We're not expecting any input or output wrappers
        ([Bool]
    _,[],[],[(Identifier, HWType)]
    _,[],[LetBinding]
    binders0,Just Id
    result) -> do
          let ([LetBinding]
    sBinders,[LetBinding]
    binders1) = Int -> [LetBinding] -> ([LetBinding], [LetBinding])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([Id] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Id]
    sArgs) [LetBinding]
    binders0
              ([LetBinding]
    iBinders,[LetBinding]
    binders2) = Int -> [LetBinding] -> ([LetBinding], [LetBinding])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([Id] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Id]
    iArgs) [LetBinding]
    binders1
              -- Get all the "original" let-bindings, without the above "mealyres".
              -- We don't want to make a NetDecl for it.
              bindersN :: [LetBinding]
    bindersN = case Term
    res0 of
                Letrec [LetBinding]
    _ (C.Var {}) -> [LetBinding]
    binders2
                Term
    _                   -> [LetBinding] -> [LetBinding]
    forall a. HasCallStack => [a] -> [a]
    init [LetBinding]
    binders2

          -- Create new net declarations for state-binders, input-binders, and all
          -- the "original" let-bindings in 'mealyFun'
          --
          -- The first set is only assigned in the always block, so they must be
          -- 'reg' in Verilog terminology
          netDeclsSeq <- (LetBinding -> NetlistMonad [Declaration])
    -> [LetBinding] -> NetlistMonad [Declaration]
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m [b]) -> [a] -> m [b]
    concatMapM LetBinding -> NetlistMonad [Declaration]
    mkNetDecl ([LetBinding]
    sBinders [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. [a] -> [a] -> [a]
    ++ [LetBinding]
    bindersN)
          -- The second set is assigned using concurrent assignment, so don't need
          -- to be 'reg'
          netDeclsInp <- concatMapM mkNetDecl iBinders

          -- If the 'mealyFun' was not a let-expression with a variable reference
          -- as a body then we used the LHS of the entire 'mealyIO' expression as
          -- a new let-binding; otherwise 'mkUniqueNormalized' would not work.
          --
          -- However, 'mkUniqueNormalized' made a new unique name for that LHS,
          -- which is not what we want. We want to assign the last expression to the
          -- LHS of 'mealyIO'.
          let bindersE = case Term
    res0 of
                            Letrec [LetBinding]
    _ (C.Var {}) -> [LetBinding]
    binders2
                            Term
    _ -> case NetlistId
    dst of
                              -- See above why we do this.
                              CoreId Id
    u0 -> [LetBinding] -> [LetBinding]
    forall a. HasCallStack => [a] -> [a]
    init [LetBinding]
    binders2 [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. [a] -> [a] -> [a]
    ++ [(Id
    u0,LetBinding -> Term
    forall a b. (a, b) -> b
    snd ([LetBinding] -> LetBinding
    forall a. HasCallStack => [a] -> a
    last [LetBinding]
    binders2))]
                              NetlistId
    _ -> [LetBinding]
    binders2
          seqDecls <- concat <$> mapM (uncurry (mkDeclarations' Sequential)) bindersE

          -- When the body the let-expression of 'mealyFun' was variable reference,
          -- or in case we had to create a new identifier because the original LHS
          -- was not available: then we need to assign
          (resExpr,resDecls) <- case res0 of
            Letrec [LetBinding]
    _ (C.Var {}) -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    Concurrent NetlistId
    dst (Id -> Term
    C.Var Id
    result)
            Term
    _ -> case NetlistId
    dst of
              CoreId {} -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Expr
    Noop,[])
              NetlistId
    _ -> HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    Sequential NetlistId
    dst (Id -> Term
    C.Var Id
    result)

          resAssn <- case resExpr of
                Expr
    Noop -> [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
                Expr
    _ -> do
                  assign <- Declaration -> Seq
    SeqDecl (Declaration -> Seq)
    -> NetlistMonad Declaration -> NetlistMonad Seq
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    dstNm Expr
    resExpr
                  pure [Seq [AlwaysComb [assign]]]

          -- Create the declarations for the "initial state" block
          let sDst = case [LetBinding]
    sBinders of
                       [] -> [Char] -> NetlistId
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient sBinders"
                       [(Id
    b,Term
    _)] -> Id -> NetlistId
    CoreId Id
    b
                       [LetBinding]
    _       -> [Id] -> NetlistId
    MultiId ((LetBinding -> Id) -> [LetBinding] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map LetBinding -> Id
    forall a b. (a, b) -> a
    fst [LetBinding]
    sBinders)

          (exprInit,initDecls) <- mkExpr False Sequential sDst mealyInit

          initAssign <- case exprInit of
            Identifier Identifier
    _ Maybe Modifier
    Nothing -> [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
            Expr
    Noop -> [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
            Expr
    _ -> case [LetBinding]
    sBinders of
              ((Id
    b,Term
    _):[LetBinding]
    _) -> do assn <- HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    b) Expr
    exprInit
                              pure [assn]
              [LetBinding]
    _ -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient sBinders"

          -- Create the declarations that corresponding to the input
          let iDst = case [LetBinding]
    iBinders of
                       []      -> [Char] -> NetlistId
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient iBinders"
                       [(Id
    b,Term
    _)] -> Id -> NetlistId
    CoreId Id
    b
                       [LetBinding]
    _       -> [Id] -> NetlistId
    MultiId ((LetBinding -> Id) -> [LetBinding] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map LetBinding -> Id
    forall a b. (a, b) -> a
    fst [LetBinding]
    iBinders)

          (exprArg,inpDeclsMisc) <- mkExpr False Concurrent iDst mealyIn

          argAssign <- case iBinders of
            ((Id
    i,Term
    _):[LetBinding]
    _) -> do assn <- HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    i) Expr
    exprArg
                            pure [assn]
            [LetBinding]
    _ -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient iBinders"

          -- Split netdecl declarations and other declarations
          let (netDeclsSeqMisc,seqDeclsOther) = partition isNet (seqDecls ++ resDecls)
              (netDeclsInit,initDeclsOther)   = partition isNet initDecls
          -- All assignments happens within a sequential block, so the nets need to
          -- be of type 'reg' in Verilog nomenclature
          let netDeclsSeq1 = [Declaration]
    netDeclsSeq [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    netDeclsSeqMisc [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    netDeclsInit

          -- We run mealy block in the opposite clock edge of the the ambient system
          -- because we're basically clocked logic; so we need to have our outputs
          -- ready before the ambient system starts sampling them. The clockGen code
          -- ensures that the "opposite" edge always comes first.
          kdTy <- unsafeCoreTypeToHWTypeM $(curLoc) (inferCoreTypeOf tcm kd)
          let edge = case HWType -> HWType
    stripVoid (FilteredHWType -> HWType
    stripFiltered FilteredHWType
    kdTy) of
                       KnownDomain Text
    _ Integer
    _ ActiveEdge
    Rising ResetKind
    _ InitBehavior
    _ ResetPolarity
    _  -> ActiveEdge
    Falling
                       KnownDomain Text
    _ Integer
    _ ActiveEdge
    Falling ResetKind
    _ InitBehavior
    _ ResetPolarity
    _ -> ActiveEdge
    Rising
                       HWType
    _ -> [Char] -> ActiveEdge
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"
          (clkExpr,clkDecls) <-
            mkExpr False Concurrent (NetlistId (Id.unsafeMake "__MEALY_CLK__") (inferCoreTypeOf tcm clk)) clk

          -- collect the declarations related to the input
          let netDeclsInp1 = [Declaration]
    netDeclsInp [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    inpDeclsMisc

          -- Collate everything
          return (clkDecls ++ netDeclsSeq1 ++ netDeclsInp1 ++ argAssign ++
                    [ Seq [Initial (map SeqDecl (initDeclsOther ++ initAssign))]
                    , Seq [AlwaysClocked edge clkExpr (map SeqDecl seqDeclsOther)]
                    ] ++ resAssn)
        ([Bool], [(Identifier, HWType)], [Declaration],
     [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    _ -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"
     where
      isNet :: Declaration -> Bool
    isNet NetDecl' {} = Bool
    True
      isNet Declaration
    _ = Bool
    False

    collectMealy Identifier
    _ NetlistId
    _ TyConMap
    _ [Term]
    _ = [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"

    -- | Collect the sequential declarations for 'bindIO'
    collectBindIO :: NetlistId -> [Term] -> NetlistMonad (Expr,[Declaration])
    #if __GLASGOW_HASKELL__ >= 900
    collectBindIO :: NetlistId -> [Term] -> NetlistMonad (Expr, [Declaration])
    collectBindIO NetlistId
    dst (Term
    m:Lam Id
    x q :: Term
    q@Term
    e:[Term]
    _) = do
    #else
    collectBindIO dst (m:Lam x q@(Lam _ e):_) = do
    #endif
      tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
      (ds0,subst) <- collectAction tcm
      let qS = HasCallStack => Doc () -> Subst -> Term -> Term
    Doc () -> Subst -> Term -> Term
    substTm Doc ()
    "collectBindIO1" Subst
    subst Term
    q
      case splitNormalized tcm qS of
        Right ([Id]
    args,[LetBinding]
    bs0,Id
    res) -> do
          let bs :: [LetBinding]
    bs = HasCallStack => [LetBinding] -> [LetBinding]
    [LetBinding] -> [LetBinding]
    inverseTopSortLetBindings [LetBinding]
    bs0
          let is0 :: InScopeSet
    is0 = UniqMap (Var Any) -> InScopeSet
    mkInScopeSet (Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    qS)
          normE <- HasCallStack =>
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    mkUniqueNormalized InScopeSet
    is0 Maybe (Maybe TopEntity)
    forall a. Maybe a
    Nothing ([Id]
    args,[LetBinding]
    bs,Id
    res)
          case normE of
            ([Bool]
    _,[(Identifier, HWType)]
    _,[],[(Identifier, HWType)]
    _,[],[LetBinding]
    binders,Just Id
    result) -> do
              ds1 <- (LetBinding -> NetlistMonad [Declaration])
    -> [LetBinding] -> NetlistMonad [Declaration]
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m [b]) -> [a] -> m [b]
    concatMapM ((Id -> Term -> NetlistMonad [Declaration])
    -> LetBinding -> NetlistMonad [Declaration]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (HasCallStack =>
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    mkDeclarations' DeclarationType
    Sequential)) [LetBinding]
    binders
              netDecls <- concatMapM mkNetDecl binders
              return (Identifier (Id.unsafeFromCoreId result) Nothing, netDecls ++ ds0 ++ ds1)
            ([Bool], [(Identifier, HWType)], [Declaration],
     [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"
        Either [Char] ([Id], [LetBinding], Id)
    _ -> case HasCallStack => Doc () -> Subst -> Term -> Term
    Doc () -> Subst -> Term -> Term
    substTm Doc ()
    "collectBindIO2" Subst
    subst Term
    e of
          Letrec {} -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"
          (Term -> (Term, [Either Term Type])
    collectArgs -> (Prim PrimInfo
    p,[Either Term Type]
    args))
            | PrimInfo -> Text
    primName PrimInfo
    p Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Explicit.SimIO.bindSimIO#" -> do
                (expr,ds1) <- NetlistId -> [Term] -> NetlistMonad (Expr, [Declaration])
    collectBindIO NetlistId
    dst ([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts [Either Term Type]
    args)
                return (expr, ds0 ++ ds1)
          Term
    eS -> do
            (expr,ds1) <- HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    Sequential NetlistId
    dst Term
    eS
            return (expr, ds0 ++ ds1)
     where
      collectAction :: TyConMap -> NetlistMonad ([Declaration], Subst)
    collectAction TyConMap
    tcm = case TyConMap -> Term -> Either [Char] ([Id], [LetBinding], Id)
    splitNormalized TyConMap
    tcm Term
    m of
        Right ([Id]
    args,[LetBinding]
    bs0,Id
    res) -> do
          let bs :: [LetBinding]
    bs = HasCallStack => [LetBinding] -> [LetBinding]
    [LetBinding] -> [LetBinding]
    inverseTopSortLetBindings [LetBinding]
    bs0
          let is0 :: InScopeSet
    is0 = UniqMap (Var Any) -> InScopeSet
    mkInScopeSet (Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    m)
          normE <- HasCallStack =>
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    mkUniqueNormalized InScopeSet
    is0 Maybe (Maybe TopEntity)
    forall a. Maybe a
    Nothing ([Id]
    args,(Id
    x,Term
    m)LetBinding -> [LetBinding] -> [LetBinding]
    forall a. a -> [a] -> [a]
    :[LetBinding]
    bs,Id
    res)
          case normE of
            ([Bool]
    _,[(Identifier, HWType)]
    _,[],[(Identifier, HWType)]
    _,[],binders :: [LetBinding]
    binders@(LetBinding
    b:[LetBinding]
    _),Just Id
    result) -> do
              let binders1 :: [LetBinding]
    binders1 = Int -> [LetBinding] -> [LetBinding]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [LetBinding]
    binders [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. [a] -> [a] -> [a]
    ++ [(LetBinding -> Id
    forall a b. (a, b) -> a
    fst LetBinding
    b, Id -> Term
    C.Var Id
    result)]
              ds1 <- (LetBinding -> NetlistMonad [Declaration])
    -> [LetBinding] -> NetlistMonad [Declaration]
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m [b]) -> [a] -> m [b]
    concatMapM ((Id -> Term -> NetlistMonad [Declaration])
    -> LetBinding -> NetlistMonad [Declaration]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (HasCallStack =>
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    mkDeclarations' DeclarationType
    Sequential)) [LetBinding]
    binders1
              netDecls <- concatMapM mkNetDecl binders
              return (netDecls ++ ds1,extendIdSubst (mkSubst eInScopeSet) x (Var (fst b)))
            ([Bool], [(Identifier, HWType)], [Declaration],
     [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    _ -> [Char] -> NetlistMonad ([Declaration], Subst)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"
        Either [Char] ([Id], [LetBinding], Id)
    _ -> do
          ([x'],s) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
    mkUnique (InScopeSet -> Subst
    mkSubst InScopeSet
    eInScopeSet) [Id
    x]
          netDecls <- concatMapM mkNetDecl [(x',m)]
          ds1 <- mkDeclarations' Sequential x' m
          return (netDecls ++ ds1,s)

      eInScopeSet :: InScopeSet
    eInScopeSet = UniqMap (Var Any) -> InScopeSet
    mkInScopeSet (Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    e)

    collectBindIO NetlistId
    _ [Term]
    es = [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    es)

    -- | Collect the sequential declarations for 'appIO'
    collectAppIO :: NetlistId -> [Term] -> [Term] -> NetlistMonad (Expr,[Declaration])
    collectAppIO :: NetlistId -> [Term] -> [Term] -> NetlistMonad (Expr, [Declaration])
    collectAppIO NetlistId
    dst (Term
    fun1:Term
    arg1:[Term]
    _) [Term]
    rest = case Term -> (Term, [Either Term Type])
    collectArgs Term
    fun1 of
      (Prim (PrimInfo Text
    "Clash.Explicit.SimIO.fmapSimIO#" Type
    _ WorkInfo
    _ IsMultiPrim
    _ PrimUnfolding
    _),([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts -> (Term
    fun0:Term
    arg0:[Term]
    _))) -> do
        tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
        let argN = (Term -> Either Term b) -> [Term] -> [Either Term b]
    forall a b. (a -> b) -> [a] -> [b]
    map (Term -> Either Term b
    forall a b. a -> Either a b
    Left (Term -> Either Term b) -> (Term -> Term) -> Term -> Either Term b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyConMap -> Term -> Term
    unSimIO TyConMap
    tcm) (Term
    arg0Term -> [Term] -> [Term]
    forall a. a -> [a] -> [a]
    :Term
    arg1Term -> [Term] -> [Term]
    forall a. a -> [a] -> [a]
    :[Term]
    rest)
        mkExpr False Sequential dst (mkApps fun0 argN)
      (Prim (PrimInfo Text
    "Clash.Explicit.SimIO.apSimIO#" Type
    _ WorkInfo
    _ IsMultiPrim
    _ PrimUnfolding
    _),([Either Term Type] -> [Term]
    forall a b. [Either a b] -> [a]
    lefts -> [Term]
    args)) -> do
        NetlistId -> [Term] -> [Term] -> NetlistMonad (Expr, [Declaration])
    collectAppIO NetlistId
    dst [Term]
    args (Term
    arg1Term -> [Term] -> [Term]
    forall a. a -> [a] -> [a]
    :[Term]
    rest)
      (Term, [Either Term Type])
    _ -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr (Term
    fun1Term -> [Term] -> [Term]
    forall a. a -> [a] -> [a]
    :Term
    arg1Term -> [Term] -> [Term]
    forall a. a -> [a] -> [a]
    :[Term]
    rest))

    collectAppIO NetlistId
    _ [Term]
    es [Term]
    _ = [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    es)

    -- | Unwrap the new-type wrapper for things of type SimIO, this is needed to
    -- allow applications of the `State# World` token to the underlying IO type.
    --
    -- XXX: this is most likely needed because Ghc2Core that threw away the cast
    -- that this unwrapping; we should really start to support casts.
    unSimIO
      :: TyConMap
      -> Term
      -> Term
    unSimIO :: TyConMap -> Term -> Term
    unSimIO TyConMap
    tcm Term
    arg =
      let argTy :: Type
    argTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    arg
      in  case Type -> TypeView
    tyView Type
    argTy of
            TyConApp TyConName
    _ [Type
    tcArg] ->
              Term -> [Either Term Type] -> Term
    mkApps (PrimInfo -> Term
    Prim (Text
    -> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
    PrimInfo
                              Text
    "Clash.Explicit.SimIO.unSimIO#"
                              (Type -> Type -> Type
    mkFunTy Type
    argTy Type
    tcArg)
                              WorkInfo
    WorkNever
                              IsMultiPrim
    SingleResult
                              PrimUnfolding
    NoUnfolding))
                     [Term -> Either Term Type
    forall a b. a -> Either a b
    Left Term
    arg]
            TypeView
    _ -> [Char] -> Term
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    arg)

    -- | Create an template instantiation text and a partial blackbox content for an
    -- argument term, given that the term is a function. Errors if the term is not
    -- a function
    mkFunInput
      :: HasCallStack
      => TextS.Text
      -- ^ Name of the primitive of which the function in question is an argument.
      -- Used for error reporting.
      -> DeclarationType
      -- ^ Are we concurrent or sequential?
      -> Id
      -- ^ Identifier binding the encompassing primitive/blackbox application. Used
      -- as a name hint if 'mkFunInput' needs intermediate signals.
      -> Term
      -- ^ The function argument term
      -> NetlistMonad
          ((Either BlackBox (Identifier,[Declaration])
           ,Usage
           ,[BlackBoxTemplate]
           ,[BlackBoxTemplate]
           ,[((TextS.Text,TextS.Text),BlackBox)]
           ,BlackBoxContext)
          ,[Declaration])
    mkFunInput :: HasCallStack =>
    Text
    -> DeclarationType
    -> Id
    -> Term
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    mkFunInput Text
    parentName DeclarationType
    declType Id
    resId Term
    e =
     let (Term
    appE,[Either Term Type]
    args,[TickInfo]
    ticks) = Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks Term
    e
     in  [TickInfo]
    -> ([Declaration]
        -> NetlistMonad
             ((Either BlackBox (Identifier, [Declaration]), Usage,
               [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
               BlackBoxContext),
              [Declaration]))
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (([Declaration]
      -> NetlistMonad
           ((Either BlackBox (Identifier, [Declaration]), Usage,
             [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
             BlackBoxContext),
            [Declaration]))
     -> NetlistMonad
          ((Either BlackBox (Identifier, [Declaration]), Usage,
            [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
            BlackBoxContext),
           [Declaration]))
    -> ([Declaration]
        -> NetlistMonad
             ((Either BlackBox (Identifier, [Declaration]), Usage,
               [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
               BlackBoxContext),
              [Declaration]))
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    forall a b. (a -> b) -> a -> b
    $ \[Declaration]
    tickDecls -> do
      tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
      -- TODO: Rewrite this function to use blackbox functions. Right now it
      -- TODO: generates strings that are later parsed/interpreted again. Silly!
      templ <- case appE of
                Prim PrimInfo
    p -> do
                  bb  <- HasCallStack => Text -> NetlistMonad CompiledPrimitive
    Text -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail (PrimInfo -> Text
    primName PrimInfo
    p)
                  case bb of
                    P.BlackBox {Bool
    [BlackBoxTemplate]
    [(Int, Int)]
    [((Text, Text), BlackBox)]
    [BlackBox]
    ()
    Text
    WorkInfo
    Usage
    BlackBox
    TemplateKind
    RenderVoid
    name :: forall a b c d. Primitive a b c d -> Text
    multiResult :: forall a b c d. Primitive a b c d -> Bool
    template :: forall a b c d. Primitive a b c d -> b
    libraries :: forall a b c d. Primitive a b c d -> [a]
    imports :: forall a b c d. Primitive a b c d -> [a]
    includes :: forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    kind :: forall a b c d. Primitive a b c d -> TemplateKind
    outputUsage :: forall a b c d. Primitive a b c d -> Usage
    renderVoid :: forall a b c d. Primitive a b c d -> RenderVoid
    name :: Text
    workInfo :: WorkInfo
    renderVoid :: RenderVoid
    multiResult :: Bool
    kind :: TemplateKind
    warning :: ()
    outputUsage :: Usage
    libraries :: [BlackBoxTemplate]
    imports :: [BlackBoxTemplate]
    functionPlurality :: [(Int, Int)]
    includes :: [((Text, Text), BlackBox)]
    resultNames :: [BlackBox]
    resultInits :: [BlackBox]
    template :: BlackBox
    resultInits :: forall a b c d. Primitive a b c d -> [b]
    resultNames :: forall a b c d. Primitive a b c d -> [b]
    functionPlurality :: forall a b c d. Primitive a b c d -> [(Int, Int)]
    warning :: forall a b c d. Primitive a b c d -> c
    workInfo :: forall a b c d. Primitive a b c d -> WorkInfo
    ..} ->
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
     [((Text, Text), BlackBox)], Text, BlackBox)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. a -> Either a b
    Left (TemplateKind
    kind,Usage
    outputUsage,[BlackBoxTemplate]
    libraries,[BlackBoxTemplate]
    imports,[((Text, Text), BlackBox)]
    includes,PrimInfo -> Text
    primName PrimInfo
    p,BlackBox
    template))
                    P.Primitive Text
    pn WorkInfo
    _ Text
    pt ->
                      [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Unexpected blackbox type: "
                                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Primitive " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    pn
                                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    pt
                    P.BlackBoxHaskell{name :: forall a b c d. Primitive a b c d -> Text
    name=Text
    pName, multiResult :: forall a b c d. Primitive a b c d -> Bool
    multiResult=Bool
    True} ->
                      -- TODO: dev pointers
                      [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error [I.i|
                        Encountered multiresult primitive as a direct argument to
                        another primitive. This should not happen.

                          Encountered: #{pName}

                        Please report this as an issue.
                      |]
                    P.BlackBoxHaskell{name :: forall a b c d. Primitive a b c d -> Text
    name=Text
    pName, functionName :: forall a b c d. Primitive a b c d -> BlackBoxFunctionName
    functionName=BlackBoxFunctionName
    fName, function :: forall a b c d. Primitive a b c d -> d
    function=(Int
    _, BlackBoxFunction
    func)} -> do
                      -- Determine result type of this blackbox. If it's not a
                      -- function, simply use its term type.
                      let ([Type]
    _, Type
    resTy) = TyConMap -> Type -> ([Type], Type)
    splitFunTys TyConMap
    tcm (TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    e)
                      bbhRes <- BlackBoxFunction
    func Bool
    True Text
    pName [Either Term Type]
    args [Type
    resTy]
                      case bbhRes of
                        Left [Char]
    err ->
                          [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ BlackBoxFunctionName -> [Char]
    forall a. Show a => a -> [Char]
    show BlackBoxFunctionName
    fName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " yielded an error: "
                                            [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err
                        Right (BlackBoxMeta{[BlackBoxTemplate]
    [(Int, Int)]
    [((Text, Text), BlackBox)]
    [BlackBox]
    Usage
    TemplateKind
    RenderVoid
    bbResultInits :: BlackBoxMeta -> [BlackBox]
    bbResultNames :: BlackBoxMeta -> [BlackBox]
    bbRenderVoid :: BlackBoxMeta -> RenderVoid
    bbIncludes :: BlackBoxMeta -> [((Text, Text), BlackBox)]
    bbFunctionPlurality :: BlackBoxMeta -> [(Int, Int)]
    bbImports :: BlackBoxMeta -> [BlackBoxTemplate]
    bbLibrary :: BlackBoxMeta -> [BlackBoxTemplate]
    bbKind :: BlackBoxMeta -> TemplateKind
    bbOutputUsage :: BlackBoxMeta -> Usage
    bbOutputUsage :: Usage
    bbKind :: TemplateKind
    bbLibrary :: [BlackBoxTemplate]
    bbImports :: [BlackBoxTemplate]
    bbFunctionPlurality :: [(Int, Int)]
    bbIncludes :: [((Text, Text), BlackBox)]
    bbRenderVoid :: RenderVoid
    bbResultNames :: [BlackBox]
    bbResultInits :: [BlackBox]
    ..}, BlackBox
    template) ->
                          Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Either
       (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
        [((Text, Text), BlackBox)], Text, BlackBox)
       ((Identifier, [Declaration]), Usage)
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $
                            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
     [((Text, Text), BlackBox)], Text, BlackBox)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. a -> Either a b
    Left ( TemplateKind
    bbKind, Usage
    bbOutputUsage, [BlackBoxTemplate]
    bbLibrary, [BlackBoxTemplate]
    bbImports
                                 , [((Text, Text), BlackBox)]
    bbIncludes, Text
    pName, BlackBox
    template)
                Data DataCon
    dc -> do
                  let eTy :: Type
    eTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    e
                      ([Type]
    _,Type
    resTy) = TyConMap -> Type -> ([Type], Type)
    splitFunTys TyConMap
    tcm Type
    eTy

                  resHTyM0 <- Type -> NetlistMonad (Maybe FilteredHWType)
    coreTypeToHWTypeM Type
    resTy
                  let resHTyM1 = (\FilteredHWType
    fHwty -> (FilteredHWType -> HWType
    stripFiltered FilteredHWType
    fHwty, FilteredHWType -> [[Bool]]
    flattenFiltered FilteredHWType
    fHwty)) (FilteredHWType -> (HWType, [[Bool]]))
    -> Maybe FilteredHWType -> Maybe (HWType, [[Bool]])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe FilteredHWType
    resHTyM0

                  case resHTyM1 of
                    -- Special case where coreTypeToHWTypeM determined a type to
                    -- be completely transparent.
                    Just (HWType
    _resHTy, [areVoids :: [Bool]
    areVoids@(Bool -> [Bool] -> Int
    forall a. Eq a => a -> [a] -> Int
    countEq Bool
    False -> Int
    1)]) -> do
                      let nonVoidArgI :: Int
    nonVoidArgI = Maybe Int -> Int
    forall a. HasCallStack => Maybe a -> a
    fromJust (Bool -> [Bool] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Bool
    False [Bool]
    areVoids)
                      let arg :: Identifier
    arg = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake ([Text] -> Text
    TextS.concat [Text
    "~ARG[", Int -> Text
    forall a. Show a => a -> Text
    showt Int
    nonVoidArgI, Text
    "]"])
                      let assign :: Declaration
    assign = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    arg Maybe Modifier
    forall a. Maybe a
    Nothing)
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "", [Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    assign]), Usage
    assignTy))

                    -- Because we filter void constructs, the argument indices and
                    -- the field indices don't necessarily correspond anymore. We
                    -- use the result of coreTypeToHWTypeM to figure out what the
                    -- original indices are. Please see the documentation in
                    -- Clash.Netlist.Util.mkADT for more information.
                    Just (resHTy :: HWType
    resHTy@(SP Text
    _ [(Text, [HWType])]
    _), [[Bool]]
    areVoids0) -> do
                      let
                          dcI :: Int
    dcI       = DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                          areVoids1 :: [Bool]
    areVoids1 = [Char] -> [[Bool]] -> Int -> [Bool]
    forall a. HasCallStack => [Char] -> [a] -> Int -> a
    indexNote ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "No areVoids with index: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    dcI) [[Bool]]
    areVoids0 Int
    dcI
                          mkArg :: a -> Identifier
    mkArg a
    i   = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text
    "~ARG[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]")
                          dcInps :: [Expr]
    dcInps    = [Identifier -> Maybe Modifier -> Expr
    Identifier (Int -> Identifier
    forall {a}. Show a => a -> Identifier
    mkArg Int
    x) Maybe Modifier
    forall a. Maybe a
    Nothing | Int
    x <- [Bool] -> [Int]
    originalIndices [Bool]
    areVoids1]
                          dcApp :: Expr
    dcApp     = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    resHTy ((HWType, Int) -> Modifier
    DC (HWType
    resHTy,Int
    dcI)) [Expr]
    dcInps
                          dcAss :: Declaration
    dcAss     = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    dcApp
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    dcAss]), Usage
    assignTy))

                    -- CustomSP the same as SP, but with a user-defined bit
                    -- level representation
                    Just (resHTy :: HWType
    resHTy@(CustomSP {}), [[Bool]]
    areVoids0) -> do
                      let
                          dcI :: Int
    dcI       = DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                          areVoids1 :: [Bool]
    areVoids1 = [Char] -> [[Bool]] -> Int -> [Bool]
    forall a. HasCallStack => [Char] -> [a] -> Int -> a
    indexNote ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "No areVoids with index: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    dcI) [[Bool]]
    areVoids0 Int
    dcI
                          mkArg :: a -> Identifier
    mkArg a
    i   = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text
    "~ARG[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]")
                          dcInps :: [Expr]
    dcInps    = [Identifier -> Maybe Modifier -> Expr
    Identifier (Int -> Identifier
    forall {a}. Show a => a -> Identifier
    mkArg Int
    x) Maybe Modifier
    forall a. Maybe a
    Nothing | Int
    x <- [Bool] -> [Int]
    originalIndices [Bool]
    areVoids1]
                          dcApp :: Expr
    dcApp     = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    resHTy ((HWType, Int) -> Modifier
    DC (HWType
    resHTy,Int
    dcI)) [Expr]
    dcInps
                          dcAss :: Declaration
    dcAss     = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    dcApp
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    dcAss]), Usage
    assignTy))

                    -- Like SP, we have to retrieve the index BEFORE filtering voids
                    Just (resHTy :: HWType
    resHTy@(Product Text
    _ Maybe [Text]
    _ [HWType]
    _), [Bool]
    areVoids1:[[Bool]]
    _) -> do
                      let mkArg :: a -> Identifier
    mkArg a
    i    = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text
    "~ARG[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]")
                          dcInps :: [Expr]
    dcInps    = [ Identifier -> Maybe Modifier -> Expr
    Identifier (Int -> Identifier
    forall {a}. Show a => a -> Identifier
    mkArg Int
    x) Maybe Modifier
    forall a. Maybe a
    Nothing | Int
    x <- [Bool] -> [Int]
    originalIndices [Bool]
    areVoids1]
                          dcApp :: Expr
    dcApp     = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    resHTy ((HWType, Int) -> Modifier
    DC (HWType
    resHTy,Int
    0)) [Expr]
    dcInps
                          dcAss :: Declaration
    dcAss     = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    dcApp
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    dcAss]), Usage
    assignTy))

                    -- Vectors never have defined areVoids (or all set to False), as
                    -- it would be converted to Void otherwise. We can therefore
                    -- safely ignore it:
                    Just (resHTy :: HWType
    resHTy@(Vector Int
    _ HWType
    _), [[Bool]]
    _areVoids) -> do
                      let mkArg :: a -> Identifier
    mkArg a
    i = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text
    "~ARG[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]")
                          dcInps :: [Expr]
    dcInps = [ Identifier -> Maybe Modifier -> Expr
    Identifier (Int -> Identifier
    forall {a}. Show a => a -> Identifier
    mkArg Int
    x) Maybe Modifier
    forall a. Maybe a
    Nothing | Int
    x <- [(Int
    1::Int)..Int
    2] ]
                          dcApp :: Expr
    dcApp  = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    resHTy ((HWType, Int) -> Modifier
    DC (HWType
    resHTy,Int
    1)) [Expr]
    dcInps
                          dcAss :: Declaration
    dcAss  = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    dcApp
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    dcAss]), Usage
    assignTy))

                    -- Sum types OR a Sum type after filtering empty types:
                    Just (resHTy :: HWType
    resHTy@(Sum Text
    _ [Text]
    _), [[Bool]]
    _areVoids) -> do
                      let dcI :: Int
    dcI   = DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                          dcApp :: Expr
    dcApp = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    resHTy ((HWType, Int) -> Modifier
    DC (HWType
    resHTy,Int
    dcI)) []
                          dcAss :: Declaration
    dcAss = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    dcApp
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    dcAss]), Usage
    assignTy))

                    -- Same as Sum, but with user defined bit level representation
                    Just (resHTy :: HWType
    resHTy@(CustomSum {}), [[Bool]]
    _areVoids) -> do
                      let dcI :: Int
    dcI   = DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                          dcApp :: Expr
    dcApp = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    resHTy ((HWType, Int) -> Modifier
    DC (HWType
    resHTy,Int
    dcI)) []
                          dcAss :: Declaration
    dcAss = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    dcApp
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration
    dcAss]), Usage
    assignTy))

                    Just (Void {}, [[Bool]]
    _areVoids) ->
                      Either
      (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
       [((Text, Text), BlackBox)], Text, BlackBox)
      ((Identifier, [Declaration]), Usage)
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([Char]
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> Either
          (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
           [((Text, Text), BlackBox)], Text, BlackBox)
          ((Identifier, [Declaration]), Usage))
    -> [Char]
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Encountered Void in mkFunInput."
                                                [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " This is a bug in Clash.")

                    Maybe (HWType, [[Bool]])
    _ -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Cannot make function input for: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e
                C.Var Id
    fun -> do
                  topAnns <- Getting (VarEnv TopEntityT) NetlistState (VarEnv TopEntityT)
    -> NetlistMonad (VarEnv TopEntityT)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting (VarEnv TopEntityT) NetlistState (VarEnv TopEntityT)
    Lens' NetlistState (VarEnv TopEntityT)
    topEntityAnns
                  case lookupVarEnv fun topAnns of
                    Just TopEntityT
    _ ->
                      [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Cannot make function input for partially applied Synthesize-annotated: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e
                    Maybe TopEntityT
    _ -> do
                      normalized <- Getting BindingMap NetlistState BindingMap
    -> NetlistMonad BindingMap
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting BindingMap NetlistState BindingMap
    Lens' NetlistState BindingMap
    bindings
                      case lookupVarEnv fun normalized of
                        Just Binding Term
    _ -> do
                          (meta,N.Component compName compInps compOutps _) <-
                            NetlistMonad (ComponentMeta, Component)
    -> NetlistMonad (ComponentMeta, Component)
    forall a. NetlistMonad a -> NetlistMonad a
    preserveVarEnv (NetlistMonad (ComponentMeta, Component)
     -> NetlistMonad (ComponentMeta, Component))
    -> NetlistMonad (ComponentMeta, Component)
    -> NetlistMonad (ComponentMeta, Component)
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Id -> NetlistMonad (ComponentMeta, Component)
    Id -> NetlistMonad (ComponentMeta, Component)
    genComponent Id
    fun

                          let
                            ComponentMeta{cmWereVoids} = meta
                            inpAssign (Identifier
    i, c
    t) d
    e' = (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    i Maybe Modifier
    forall a. Maybe a
    Nothing, PortDirection
    In, c
    t, d
    e')
                            inpVar a
    i = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text
    "~VAR[arg" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "][" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]")
                            inpVars = [Identifier -> Maybe Modifier -> Expr
    Identifier (Int -> Identifier
    forall {a}. Show a => a -> Identifier
    inpVar Int
    i)  Maybe Modifier
    forall a. Maybe a
    Nothing | Int
    i <- [Bool] -> [Int]
    originalIndices [Bool]
    cmWereVoids]
                            inpAssigns = ((Identifier, HWType)
     -> Expr -> (Expr, PortDirection, HWType, Expr))
    -> [(Identifier, HWType)]
    -> [Expr]
    -> [(Expr, PortDirection, HWType, Expr)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Identifier, HWType) -> Expr -> (Expr, PortDirection, HWType, Expr)
    forall {c} {d}. (Identifier, c) -> d -> (Expr, PortDirection, c, d)
    inpAssign [(Identifier, HWType)]
    compInps [Expr]
    inpVars
                            outpAssigns = case [(Usage, (Identifier, HWType), Maybe Expr)]
    compOutps of
                              [] -> [] -- See issue #2549
                              [(Usage
    _,(Identifier, HWType)
    compOutp,Maybe Expr
    _)] ->
                                [ ( Identifier -> Maybe Modifier -> Expr
    Identifier ((Identifier, HWType) -> Identifier
    forall a b. (a, b) -> a
    fst (Identifier, HWType)
    compOutp) Maybe Modifier
    forall a. Maybe a
    Nothing
                                  , PortDirection
    Out
                                  , (Identifier, HWType) -> HWType
    forall a b. (a, b) -> b
    snd (Identifier, HWType)
    compOutp
                                  , Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Maybe Modifier
    forall a. Maybe a
    Nothing )
                                ]
                              [(Usage, (Identifier, HWType), Maybe Expr)]
    outps ->
                                [Char] -> [(Expr, PortDirection, HWType, Expr)]
    forall a. HasCallStack => [Char] -> a
    error [I.i|
                                  Cannot handle multi-result function as an argument to
                                  a primitive.

                                  Primitive: #{parentName}

                                  Argument: #{showPpr fun} :: #{showPpr (varType fun)}

                                  Outputs: #{show (map (\(_,x,_) -> x) outps)}

                                  Please report this as an issue.
                                |]
                          instLabel <- Id.next compName
                          let
                            portMap = [(Expr, PortDirection, HWType, Expr)] -> PortMap
    NamedPortMap ([(Expr, PortDirection, HWType, Expr)]
    outpAssigns [(Expr, PortDirection, HWType, Expr)]
    -> [(Expr, PortDirection, HWType, Expr)]
    -> [(Expr, PortDirection, HWType, Expr)]
    forall a. [a] -> [a] -> [a]
    ++ [(Expr, PortDirection, HWType, Expr)]
    inpAssigns)
                            instDecl = EntityOrComponent
    -> Maybe Text
    -> [Attr Text]
    -> Identifier
    -> Identifier
    -> [(Expr, HWType, Expr)]
    -> PortMap
    -> Declaration
    InstDecl EntityOrComponent
    Entity Maybe Text
    forall a. Maybe a
    Nothing [] Identifier
    compName Identifier
    instLabel [] PortMap
    portMap
                          return (Right ((Id.unsafeMake "",tickDecls ++ [instDecl]), Cont))
                        Maybe (Binding Term)
    Nothing -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Cannot make function input for: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e
                C.Lam {} -> do
                  let is0 :: InScopeSet
    is0 = UniqMap (Var Any) -> InScopeSet
    mkInScopeSet (Getting (UniqMap (Var Any)) Term Id
    -> (Id -> UniqMap (Var Any)) -> Term -> UniqMap (Var Any)
    forall r s a. Getting r s a -> (a -> r) -> s -> r
    Lens.foldMapOf Getting (UniqMap (Var Any)) Term Id
    Fold Term Id
    freeIds Id -> UniqMap (Var Any)
    forall a. Var a -> UniqMap (Var Any)
    unitVarSet Term
    appE)
                  ((TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
      [((Text, Text), BlackBox)], Text, BlackBox)
     -> Either
          (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
           [((Text, Text), BlackBox)], Text, BlackBox)
          ((Identifier, [Declaration]), Usage))
    -> (((Identifier, [Declaration]), Usage)
        -> Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage))
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
     [((Text, Text), BlackBox)], Text, BlackBox)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. a -> Either a b
    Left (((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right (((Identifier, [Declaration]), Usage)
     -> Either
          (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
           [((Text, Text), BlackBox)], Text, BlackBox)
          ((Identifier, [Declaration]), Usage))
    -> (((Identifier, [Declaration]), Usage)
        -> ((Identifier, [Declaration]), Usage))
    -> ((Identifier, [Declaration]), Usage)
    -> Either
         (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
          [((Text, Text), BlackBox)], Text, BlackBox)
         ((Identifier, [Declaration]), Usage)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Identifier, [Declaration]) -> (Identifier, [Declaration]))
    -> ((Identifier, [Declaration]), Usage)
    -> ((Identifier, [Declaration]), Usage)
    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 (([Declaration] -> [Declaration])
    -> (Identifier, [Declaration]) -> (Identifier, [Declaration])
    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 ([Declaration]
    tickDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++))) (Either
       (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
        [((Text, Text), BlackBox)], Text, BlackBox)
       ((Identifier, [Declaration]), Usage)
     -> Either
          (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
           [((Text, Text), BlackBox)], Text, BlackBox)
          ((Identifier, [Declaration]), Usage))
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> InScopeSet
    -> Int
    -> Term
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall {a}.
    InScopeSet
    -> Int
    -> Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    go InScopeSet
    is0 Int
    0 Term
    appE
                Term
    _ -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          (Either
             (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
              [((Text, Text), BlackBox)], Text, BlackBox)
             ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad
         (Either
            (TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
             [((Text, Text), BlackBox)], Text, BlackBox)
            ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Cannot make function input for: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e
      let pNm = case Term
    appE of
                  Prim PrimInfo
    p -> PrimInfo -> Text
    primName PrimInfo
    p
                  Term
    _ -> Text
    "__INTERNAL__"
      (bbCtx,dcls) <- mkBlackBoxContext pNm declType [resId] args
      case templ of
        Left (TemplateKind
    TDecl,Usage
    outputUsage,[BlackBoxTemplate]
    libs,[BlackBoxTemplate]
    imps,[((Text, Text), BlackBox)]
    inc,Text
    _,BlackBox
    templ') -> do
          (l',templDecl)
            <- (BlackBoxTemplate -> NetlistMonad (BlackBox, [Declaration]))
    -> ([Char]
        -> Int
        -> TemplateFunction
        -> NetlistMonad (BlackBox, [Declaration]))
    -> BlackBox
    -> NetlistMonad (BlackBox, [Declaration])
    forall r.
    (BlackBoxTemplate -> r)
    -> ([Char] -> Int -> TemplateFunction -> r) -> BlackBox -> r
    onBlackBox
                (((BlackBoxTemplate, [Declaration]) -> (BlackBox, [Declaration]))
    -> NetlistMonad (BlackBoxTemplate, [Declaration])
    -> NetlistMonad (BlackBox, [Declaration])
    forall a b. (a -> b) -> NetlistMonad a -> NetlistMonad b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((BlackBoxTemplate -> BlackBox)
    -> (BlackBoxTemplate, [Declaration]) -> (BlackBox, [Declaration])
    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 BlackBoxTemplate -> BlackBox
    BBTemplate) (NetlistMonad (BlackBoxTemplate, [Declaration])
     -> NetlistMonad (BlackBox, [Declaration]))
    -> (BlackBoxTemplate
        -> NetlistMonad (BlackBoxTemplate, [Declaration]))
    -> BlackBoxTemplate
    -> NetlistMonad (BlackBox, [Declaration])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlackBoxContext
    -> BlackBoxTemplate
    -> NetlistMonad (BlackBoxTemplate, [Declaration])
    forall (m :: Type -> Type).
    IdentifierSetMonad m =>
    BlackBoxContext
    -> BlackBoxTemplate -> m (BlackBoxTemplate, [Declaration])
    setSym BlackBoxContext
    bbCtx)
                (\[Char]
    bbName Int
    bbHash TemplateFunction
    bbFunc -> (BlackBox, [Declaration]) -> NetlistMonad (BlackBox, [Declaration])
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((BlackBox, [Declaration])
     -> NetlistMonad (BlackBox, [Declaration]))
    -> (BlackBox, [Declaration])
    -> NetlistMonad (BlackBox, [Declaration])
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Int -> TemplateFunction -> BlackBox
    BBFunction [Char]
    bbName Int
    bbHash TemplateFunction
    bbFunc, []))
                BlackBox
    templ'
          return ((Left l',outputUsage,libs,imps,inc,bbCtx),dcls ++ templDecl)
        Left (TemplateKind
    TExpr,Usage
    _,[BlackBoxTemplate]
    libs,[BlackBoxTemplate]
    imps,[((Text, Text), BlackBox)]
    inc,Text
    nm,BlackBox
    templ') -> do
          (BlackBoxTemplate
     -> NetlistMonad
          ((Either BlackBox (Identifier, [Declaration]), Usage,
            [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
            BlackBoxContext),
           [Declaration]))
    -> ([Char]
        -> Int
        -> TemplateFunction
        -> NetlistMonad
             ((Either BlackBox (Identifier, [Declaration]), Usage,
               [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
               BlackBoxContext),
              [Declaration]))
    -> BlackBox
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    forall r.
    (BlackBoxTemplate -> r)
    -> ([Char] -> Int -> TemplateFunction -> r) -> BlackBox -> r
    onBlackBox
            (\BlackBoxTemplate
    t -> do t' <- Ap NetlistMonad Text -> NetlistMonad Text
    forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
    getAp (BlackBoxTemplate -> Ap NetlistMonad Text
    forall (m :: Type -> Type).
    Monad m =>
    BlackBoxTemplate -> Ap m Text
    prettyBlackBox BlackBoxTemplate
    t)
                      let t'' = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text -> Text
    Text.toStrict Text
    t')
                          assn = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    t'' Maybe Modifier
    forall a. Maybe a
    Nothing)
                      return ((Right (Id.unsafeMake "",[assn]),assignTy,libs,imps,inc,bbCtx),dcls))
            (\[Char]
    bbName Int
    bbHash (TemplateFunction [Int]
    k BlackBoxContext -> Bool
    g forall s. Backend s => BlackBoxContext -> State s (Doc ())
    _) -> do
              let f' :: BlackBoxContext -> State state (Doc ())
    f' BlackBoxContext
    bbCtx' = do
                    let assn :: Declaration
    assn = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy
                                (Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Bool
    -> Expr
    BlackBoxE Text
    nm [BlackBoxTemplate]
    libs [BlackBoxTemplate]
    imps [((Text, Text), BlackBox)]
    inc BlackBox
    templ' BlackBoxContext
    bbCtx' Bool
    False)
                    p <- Ap (State state) (Doc ()) -> State state (Doc ())
    forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
    getAp (Identifier -> [Declaration] -> Ap (State state) (Doc ())
    forall state.
    Backend state =>
    Identifier -> [Declaration] -> Ap (State state) (Doc ())
    Backend.blockDecl (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "") [Declaration
    assn])
                    return p
              ((Either BlackBox (Identifier, [Declaration]), Usage,
      [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
      BlackBoxContext),
     [Declaration])
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ((BlackBox -> Either BlackBox (Identifier, [Declaration])
    forall a b. a -> Either a b
    Left ([Char] -> Int -> TemplateFunction -> BlackBox
    BBFunction [Char]
    bbName Int
    bbHash ([Int]
    -> (BlackBoxContext -> Bool)
    -> (forall s. Backend s => BlackBoxContext -> State s (Doc ()))
    -> TemplateFunction
    TemplateFunction [Int]
    k BlackBoxContext -> Bool
    g BlackBoxContext -> State s (Doc ())
    forall s. Backend s => BlackBoxContext -> State s (Doc ())
    f'))
                      ,Usage
    assignTy
                      ,[]
                      ,[]
                      ,[]
                      ,BlackBoxContext
    bbCtx
                      )
                     ,[Declaration]
    dcls
                     )
            )
            BlackBox
    templ'
        Right ((Identifier, [Declaration])
    decl,Usage
    u) ->
          ((Either BlackBox (Identifier, [Declaration]), Usage,
      [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
      BlackBoxContext),
     [Declaration])
    -> NetlistMonad
         ((Either BlackBox (Identifier, [Declaration]), Usage,
           [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
           BlackBoxContext),
          [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration])
    -> Either BlackBox (Identifier, [Declaration])
    forall a b. b -> Either a b
    Right (Identifier, [Declaration])
    decl,Usage
    u,[],[],[],BlackBoxContext
    bbCtx),[Declaration]
    dcls)
      where
        assignTy :: Usage
    assignTy = DeclarationType -> Usage
    declTypeUsage DeclarationType
    declType

        goExpr :: Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr app :: Term
    app@(Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks -> (C.Var Id
    fun,args :: [Either Term Type]
    args@(Either Term Type
    _:[Either Term Type]
    _),[TickInfo]
    ticks)) = do
          tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
          resTy <- unsafeCoreTypeToHWTypeM' $(curLoc) (inferCoreTypeOf tcm app)
          let (tmArgs,tyArgs) = partitionEithers args
          if null tyArgs
            then
              withTicks ticks $ \[Declaration]
    tickDecls -> do
                resNm <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "result"
                appDecls <- mkFunApp declType resNm fun tmArgs tickDecls
                let assn = [ Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    resNm Maybe Modifier
    forall a. Maybe a
    Nothing)
                           , Maybe Text -> Identifier -> HWType -> Declaration
    NetDecl Maybe Text
    forall a. Maybe a
    Nothing Identifier
    resNm HWType
    resTy ]
                nm <- Id.makeBasic "block"
                return (Right ((nm,assn++appDecls), assignTy))
            else do
              (_,sp) <- Lens.use curCompNm
              throw (ClashException sp ($(curLoc) ++ "Not in normal form: Var-application with Type arguments:\n\n" ++ showPpr app) Nothing)
        goExpr Term
    e' = do
          tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
          let eType = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    e'
          (appExpr,appDecls) <- mkExpr False declType (NetlistId (Id.unsafeMake "c$bb_res") eType) e'
          let assn = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    appExpr
          nm <- if null appDecls
                   then return (Id.unsafeMake "")
                   else Id.makeBasic "block"
          return (Right ((nm,appDecls ++ [assn]), assignTy))

        go :: InScopeSet
    -> Int
    -> Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    go InScopeSet
    is0 Int
    n (Lam Id
    id_ Term
    e') = do
          lvl <- Getting Int NetlistState Int -> NetlistMonad Int
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting Int NetlistState Int
    Lens' NetlistState Int
    curBBlvl
          let nm    = [Text] -> Text
    TextS.concat
                        [Text
    "~ARGN[",[Char] -> Text
    TextS.pack (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    lvl),Text
    "][",[Char] -> Text
    TextS.pack (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n),Text
    "]"]
              v'    = InScopeSet -> Id -> Id
    forall a. (Uniquable a, ClashPretty a) => InScopeSet -> a -> a
    uniqAway InScopeSet
    is0 ((TmName -> TmName) -> Id -> Id
    forall a. (Name a -> Name a) -> Var a -> Var a
    modifyVarName (\TmName
    v -> TmName
    v {nameOcc = nm}) Id
    id_)
              subst = Subst -> Id -> Term -> Subst
    extendIdSubst (InScopeSet -> Subst
    mkSubst InScopeSet
    is0) Id
    id_ (Id -> Term
    C.Var Id
    v')
              e''   = HasCallStack => Doc () -> Subst -> Term -> Term
    Doc () -> Subst -> Term -> Term
    substTm Doc ()
    "mkFunInput.goLam" Subst
    subst Term
    e'
              is1   = InScopeSet -> Id -> InScopeSet
    forall a. InScopeSet -> Var a -> InScopeSet
    extendInScopeSet InScopeSet
    is0 Id
    v'
          go is1 (n+(1::Int)) e''

        go InScopeSet
    _ Int
    _ (C.Var Id
    v) = do
          let assn :: Declaration
    assn = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    v) Maybe Modifier
    forall a. Maybe a
    Nothing)
          Either a ((Identifier, [Declaration]), Usage)
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either a ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[Declaration
    assn]), Usage
    assignTy))

        go InScopeSet
    _ Int
    _ (Case Term
    scrut Type
    ty [Alt
    alt]) = do
          tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
          let sTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    scrut
          (projection,decls) <- mkProjection declType False (NetlistId (Id.unsafeMake "c$bb_res") sTy) scrut ty alt
          let assn = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy Expr
    projection
          nm <- if null decls
                   then return (Id.unsafeMake "")
                   else Id.makeBasic "projection"
          return (Right ((nm,decls ++ [assn]), assignTy))

        go InScopeSet
    _ Int
    _ (Case Term
    scrut Type
    ty (Alt
    alt:alts :: [Alt]
    alts@(Alt
    _:[Alt]
    _))) = do
          resNm <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.make Text
    "result"
          resTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty
          -- It's safe to use 'mkUnsafeSystemName' here: only the name, not the
          -- unique, will be used
          let resId'  = Identifier -> Type -> NetlistId
    NetlistId Identifier
    resNm Type
    ty
          selectionDecls <- mkSelection declType resId' scrut ty (alt :| alts) []
          let assn = [ Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    resNm HWType
    resTy Maybe Expr
    forall a. Maybe a
    Nothing
                     , Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    resNm Maybe Modifier
    forall a. Maybe a
    Nothing) ]
          nm <- Id.makeBasic "selection"
          return (Right ((nm,assn++selectionDecls), assignTy))

        go InScopeSet
    is0 Int
    _ e' :: Term
    e'@(Let{}) = do
          tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
          let normE = TyConMap -> Term -> Either [Char] ([Id], [LetBinding], Id)
    splitNormalized TyConMap
    tcm Term
    e'
          (_,[],[],_,[],binders,resultM) <- case normE of
            Right ([Id], [LetBinding], Id)
    norm -> HasCallStack =>
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    mkUniqueNormalized InScopeSet
    is0 Maybe (Maybe TopEntity)
    forall a. Maybe a
    Nothing ([Id], [LetBinding], Id)
    norm
            Left [Char]
    err -> [Char]
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    err
          case resultM of
            Just Id
    result -> do
              -- TODO: figure out what to do with multires blackboxes here
              netDecls <- (LetBinding -> NetlistMonad [Declaration])
    -> [LetBinding] -> NetlistMonad [Declaration]
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m [b]) -> [a] -> m [b]
    concatMapM LetBinding -> NetlistMonad [Declaration]
    mkNetDecl ([LetBinding] -> NetlistMonad [Declaration])
    -> [LetBinding] -> NetlistMonad [Declaration]
    forall a b. (a -> b) -> a -> b
    $ [LetBinding]
    binders
              decls    <- concatMapM (uncurry mkDeclarations) binders
              nm <- Id.makeBasic "fun"
              let resultId = HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    result
              -- TODO: Due to reasons lost in the mists of time, #1265 creates an
              -- assignement here, whereas it previously wouldn't. With the PR in
              -- tests break when reverting to the old behavior. In some cases this
              -- creates "useless" assignments. We should investigate whether we can
              -- get the old behavior back.
              let resDecl = Identifier -> Usage -> Expr -> Declaration
    Assignment (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "~RESULT") Usage
    assignTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    resultId Maybe Modifier
    forall a. Maybe a
    Nothing)
              return (Right ((nm,resDecl:netDecls ++ decls), assignTy))
            Maybe Id
    Nothing -> Either a ((Identifier, [Declaration]), Usage)
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (((Identifier, [Declaration]), Usage)
    -> Either a ((Identifier, [Declaration]), Usage)
    forall a b. b -> Either a b
    Right ((HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "",[]), Usage
    Cont))

        go InScopeSet
    is0 Int
    n (Tick TickInfo
    _ Term
    e') = InScopeSet
    -> Int
    -> Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    go InScopeSet
    is0 Int
    n Term
    e'

        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(App {}) = Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall {a}.
    Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr Term
    e'
        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(C.Data {}) = Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall {a}.
    Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr Term
    e'
        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(C.Literal {}) = Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall {a}.
    Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr Term
    e'
        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(Cast {}) = Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall {a}.
    Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr Term
    e'
        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(Prim {}) = Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall {a}.
    Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr Term
    e'
        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(TyApp {}) = Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall {a}.
    Term
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    goExpr Term
    e'

        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(Case Term
    _ Type
    _ []) =
          [Char]
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Cannot make function input for case without alternatives: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall a. Show a => a -> [Char]
    show Term
    e'

        go InScopeSet
    _ Int
    _ e' :: Term
    e'@(TyLam {}) =
          [Char]
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage)))
    -> [Char]
    -> NetlistMonad (Either a ((Identifier, [Declaration]), Usage))
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Cannot make function input for TyLam: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall a. Show a => a -> [Char]
    show Term
    e'