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

      Create Netlists out of normalized CoreHW Terms
    -}

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

    module Clash.Netlist where

    import           Control.Exception                (throw)
    import           Control.Lens                     ((.=), (<~))
    import qualified Control.Lens                     as Lens
    import           Control.Monad                    (zipWithM)
    import           Control.Monad.Extra              (concatMapM, mapMaybeM)
    import           Control.Monad.Reader             (runReaderT)
    import           Control.Monad.State.Strict       (State, runStateT, runState)
    import           Data.Bifunctor                   (first, second)
    import           Data.Char                        (ord)
    import           Data.Either                      (partitionEithers, rights)
    import           Data.Foldable                    (foldlM)
    import           Data.List                        (elemIndex, partition)
    import           Data.List.Extra                  (zipEqual)
    import           Data.List.NonEmpty               (NonEmpty (..))
    import qualified Data.List.NonEmpty.Extra         as NE
    import           Data.Maybe
      (listToMaybe, fromMaybe)
    import qualified Data.Map.Ordered                 as OMap
    import qualified Data.Set                         as Set
    import qualified Data.Text                        as StrictText
    import           GHC.Stack                        (HasCallStack)

    #if MIN_VERSION_ghc(9,0,0)
    import           GHC.Utils.Outputable             (ppr, showSDocUnsafe)
    import           GHC.Types.SrcLoc                 (isGoodSrcSpan)
    #else
    import           Outputable                       (ppr, showSDocUnsafe)
    import           SrcLoc                           (isGoodSrcSpan)
    #endif

    import           Clash.Annotations.Primitive      (HDL)
    import           Clash.Annotations.BitRepresentation.ClashLib
      (coreToType')
    import           Clash.Annotations.BitRepresentation.Internal
      (CustomReprs, DataRepr'(..), ConstrRepr'(..), getDataRepr, getConstrRepr)
    import           Clash.Core.DataCon               (DataCon (..))
    import           Clash.Core.HasType
    import           Clash.Core.Literal               (Literal (..))
    import           Clash.Core.Name                  (Name(..))
    import           Clash.Core.Pretty                (showPpr)
    import           Clash.Core.Term
      (IsMultiPrim (..), PrimInfo (..), mpi_resultTypes,  Alt, Pat (..), Term (..),
       TickInfo (..), collectArgs, collectArgsTicks,
       collectTicks, mkApps, mkTicks, stripTicks)
    import qualified Clash.Core.Term                  as Core
    import           Clash.Core.TermInfo              (multiPrimInfo', splitMultiPrimArgs)
    import           Clash.Core.Type
      (Type (..), coreView1, splitFunForallTy, splitCoreFunForallTy)
    import           Clash.Core.TyCon                 (TyConMap)
    import           Clash.Core.Util                  (splitShouldSplit)
    import           Clash.Core.Var                   (Id, Var (..), isGlobalId)
    import           Clash.Core.VarEnv
      (VarEnv, emptyInScopeSet, emptyVarEnv, extendVarEnv, lookupVarEnv,
       lookupVarEnv')
    import           Clash.Driver.Types               (BindingMap, Binding(..), ClashEnv(..), ClashOpts (..))
    import           Clash.Netlist.BlackBox
    import qualified Clash.Netlist.Id                 as Id
    import           Clash.Netlist.Types              as HW
    import           Clash.Netlist.Util
    import           Clash.Primitives.Types           as P
    import           Clash.Util
    import qualified Clash.Util.Interpolate           as I

    -- | Generate a hierarchical netlist out of a set of global binders with
    -- @topEntity@ at the top.
    genNetlist
      :: ClashEnv
      -> Bool
      -- ^ Whether this we're compiling a testbench (suppresses certain warnings)
      -> BindingMap
      -- ^ Global binders
      -> VarEnv TopEntityT
      -- ^ TopEntity annotations
      -> VarEnv Identifier
      -- ^ Top entity names
      -> (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -- ^ Hardcoded Type -> HWType translator
      -> Bool
      -- ^ Whether the backend supports ifThenElse expressions
      -> SomeBackend
      -- ^ The current HDL backend
      -> IdentifierSet
      -- ^ Seen components
      -> FilePath
      -- ^ HDL dir
      -> Maybe StrictText.Text
      -- ^ Component name prefix
      -> Id
      -- ^ Name of the @topEntity@
      -> IO (Component, ComponentMap, IdentifierSet)
    genNetlist :: ClashEnv
    -> Bool
    -> BindingMap
    -> VarEnv TopEntityT
    -> VarEnv Identifier
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either [Char] FilteredHWType)))
    -> Bool
    -> SomeBackend
    -> IdentifierSet
    -> [Char]
    -> Maybe Text
    -> Id
    -> IO (Component, ComponentMap, IdentifierSet)
    genNetlist ClashEnv
    env Bool
    isTb BindingMap
    globals VarEnv TopEntityT
    tops VarEnv Identifier
    topNames CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either [Char] FilteredHWType))
    typeTrans Bool
    ite SomeBackend
    be IdentifierSet
    seen0 [Char]
    dir Maybe Text
    prefixM Id
    topEntity = do
      ((_meta, topComponent), s) <-
        ClashEnv
    -> Bool
    -> BindingMap
    -> VarEnv TopEntityT
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either [Char] FilteredHWType)))
    -> Bool
    -> SomeBackend
    -> IdentifierSet
    -> [Char]
    -> VarEnv Identifier
    -> NetlistMonad (ComponentMeta, Component)
    -> IO ((ComponentMeta, Component), NetlistState)
    forall a.
    ClashEnv
    -> Bool
    -> BindingMap
    -> VarEnv TopEntityT
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either [Char] FilteredHWType)))
    -> Bool
    -> SomeBackend
    -> IdentifierSet
    -> [Char]
    -> VarEnv Identifier
    -> NetlistMonad a
    -> IO (a, NetlistState)
    runNetlistMonad ClashEnv
    env Bool
    isTb BindingMap
    globals VarEnv TopEntityT
    tops CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either [Char] FilteredHWType))
    typeTrans Bool
    ite SomeBackend
    be IdentifierSet
    seen1 [Char]
    dir VarEnv Identifier
    componentNames_
          (NetlistMonad (ComponentMeta, Component)
     -> IO ((ComponentMeta, Component), NetlistState))
    -> NetlistMonad (ComponentMeta, Component)
    -> IO ((ComponentMeta, Component), NetlistState)
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Id -> NetlistMonad (ComponentMeta, Component)
    Id -> NetlistMonad (ComponentMeta, Component)
    genComponent Id
    topEntity
      return (topComponent, _components s, seen1)
     where
      (VarEnv Identifier
    componentNames_, IdentifierSet
    seen1) =
        Bool
    -> Maybe Text
    -> IdentifierSet
    -> VarEnv Identifier
    -> BindingMap
    -> (VarEnv Identifier, IdentifierSet)
    genNames (ClashOpts -> Bool
    opt_newInlineStrat (ClashEnv -> ClashOpts
    envOpts ClashEnv
    env)) Maybe Text
    prefixM IdentifierSet
    seen0 VarEnv Identifier
    topNames BindingMap
    globals

    -- | Run a NetlistMonad action in a given environment
    runNetlistMonad
      :: ClashEnv
      -> Bool
      -- ^ Whether this we're compiling a testbench (suppresses certain warnings)
      -> BindingMap
      -- ^ Global binders
      -> VarEnv TopEntityT
      -- ^ TopEntity annotations
      -> (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -- ^ Hardcode Type -> HWType translator
      -> Bool
      -- ^ Whether the backend supports ifThenElse expressions
      -> SomeBackend
      -- ^ The current HDL backend
      -> IdentifierSet
      -- ^ Seen components
      -> FilePath
      -- ^ HDL dir
      -> VarEnv Identifier
      -- ^ Seen components
      -> NetlistMonad a
      -- ^ Action to run
      -> IO (a, NetlistState)
    runNetlistMonad :: forall a.
    ClashEnv
    -> Bool
    -> BindingMap
    -> VarEnv TopEntityT
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State HWMap (Maybe (Either [Char] FilteredHWType)))
    -> Bool
    -> SomeBackend
    -> IdentifierSet
    -> [Char]
    -> VarEnv Identifier
    -> NetlistMonad a
    -> IO (a, NetlistState)
    runNetlistMonad ClashEnv
    env Bool
    isTb BindingMap
    s VarEnv TopEntityT
    tops CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either [Char] FilteredHWType))
    typeTrans Bool
    ite SomeBackend
    be IdentifierSet
    seenIds_ [Char]
    dir VarEnv Identifier
    componentNames_
      = (ReaderT NetlistEnv IO (a, NetlistState)
     -> NetlistEnv -> IO (a, NetlistState))
    -> NetlistEnv
    -> ReaderT NetlistEnv IO (a, NetlistState)
    -> IO (a, NetlistState)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT NetlistEnv IO (a, NetlistState)
    -> NetlistEnv -> IO (a, NetlistState)
    forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
    runReaderT (ClashEnv -> Text -> Text -> Maybe Text -> NetlistEnv
    NetlistEnv ClashEnv
    env Text
    "" Text
    "" Maybe Text
    forall a. Maybe a
    Nothing)
      (ReaderT NetlistEnv IO (a, NetlistState) -> IO (a, NetlistState))
    -> (NetlistMonad a -> ReaderT NetlistEnv IO (a, NetlistState))
    -> NetlistMonad a
    -> IO (a, NetlistState)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StateT NetlistState (ReaderT NetlistEnv IO) a
     -> NetlistState -> ReaderT NetlistEnv IO (a, NetlistState))
    -> NetlistState
    -> StateT NetlistState (ReaderT NetlistEnv IO) a
    -> ReaderT NetlistEnv IO (a, NetlistState)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT NetlistState (ReaderT NetlistEnv IO) a
    -> NetlistState -> ReaderT NetlistEnv IO (a, NetlistState)
    forall s (m :: Type -> Type) a. StateT s m a -> s -> m (a, s)
    runStateT NetlistState
    s'
      (StateT NetlistState (ReaderT NetlistEnv IO) a
     -> ReaderT NetlistEnv IO (a, NetlistState))
    -> (NetlistMonad a
        -> StateT NetlistState (ReaderT NetlistEnv IO) a)
    -> NetlistMonad a
    -> ReaderT NetlistEnv IO (a, NetlistState)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NetlistMonad a -> StateT NetlistState (ReaderT NetlistEnv IO) a
    forall a.
    NetlistMonad a -> StateT NetlistState (ReaderT NetlistEnv IO) a
    runNetlist
      where
        s' :: NetlistState
    s' =
          NetlistState
            { _bindings :: BindingMap
    _bindings=BindingMap
    s
            , _components :: ComponentMap
    _components=ComponentMap
    forall k v. OMap k v
    OMap.empty
            , _typeTranslator :: CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either [Char] FilteredHWType))
    _typeTranslator=CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either [Char] FilteredHWType))
    typeTrans
            , _curCompNm :: (Identifier, SrcSpan)
    _curCompNm=([Char] -> Identifier
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "genComponent should have set _curCompNm", SrcSpan
    noSrcSpan)
            , _seenIds :: IdentifierSet
    _seenIds=IdentifierSet
    seenIds_
            , _seenComps :: IdentifierSet
    _seenComps=IdentifierSet
    seenIds_
            , _seenPrimitives :: Set Text
    _seenPrimitives=Set Text
    forall a. Set a
    Set.empty
            , _componentNames :: VarEnv Identifier
    _componentNames=VarEnv Identifier
    componentNames_
            , _topEntityAnns :: VarEnv TopEntityT
    _topEntityAnns=VarEnv TopEntityT
    tops
            , _hdlDir :: [Char]
    _hdlDir=[Char]
    dir
            , _curBBlvl :: Int
    _curBBlvl=Int
    0
            , _isTestBench :: Bool
    _isTestBench=Bool
    isTb
            , _backEndITE :: Bool
    _backEndITE=Bool
    ite
            , _backend :: SomeBackend
    _backend=SomeBackend
    be
            , _htyCache :: HWMap
    _htyCache=HWMap
    forall a. Monoid a => a
    mempty
            , _usages :: UsageMap
    _usages=UsageMap
    forall a. Monoid a => a
    mempty
            }

    -- | Generate names for all binders in "BindingMap", except for the ones already
    -- present in given identifier varenv.
    genNames
      :: Bool
      -- ^ New inline strategy enabled?
      -> Maybe StrictText.Text
      -- ^ Prefix
      -> IdentifierSet
      -- ^ Identifier set to extend
      -> VarEnv Identifier
      -- ^ Pre-generated names
      -> BindingMap
      -> (VarEnv Identifier, IdentifierSet)
    genNames :: Bool
    -> Maybe Text
    -> IdentifierSet
    -> VarEnv Identifier
    -> BindingMap
    -> (VarEnv Identifier, IdentifierSet)
    genNames Bool
    newInlineStrat Maybe Text
    prefixM IdentifierSet
    is VarEnv Identifier
    env BindingMap
    bndrs =
      State IdentifierSet (VarEnv Identifier)
    -> IdentifierSet -> (VarEnv Identifier, IdentifierSet)
    forall s a. State s a -> s -> (a, s)
    runState ((VarEnv Identifier
     -> Binding Term -> State IdentifierSet (VarEnv Identifier))
    -> VarEnv Identifier
    -> BindingMap
    -> State IdentifierSet (VarEnv Identifier)
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM VarEnv Identifier
    -> Binding Term -> State IdentifierSet (VarEnv Identifier)
    forall {f :: Type -> Type} {a}.
    IdentifierSetMonad f =>
    VarEnv Identifier -> Binding a -> f (VarEnv Identifier)
    go VarEnv Identifier
    env BindingMap
    bndrs) IdentifierSet
    is
     where
      go :: VarEnv Identifier -> Binding a -> f (VarEnv Identifier)
    go VarEnv Identifier
    env_ (Binding a -> Id
    forall a. Binding a -> Id
    bindingId -> Id
    id_) =
        case Id -> VarEnv Identifier -> Maybe Identifier
    forall b a. Var b -> VarEnv a -> Maybe a
    lookupVarEnv Id
    id_ VarEnv Identifier
    env_ of
          Just Identifier
    _ -> VarEnv Identifier -> f (VarEnv Identifier)
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure VarEnv Identifier
    env_
          Maybe Identifier
    Nothing -> do
            nm <- Text -> f Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic (Bool -> Maybe Text -> Id -> Text
    genComponentName Bool
    newInlineStrat Maybe Text
    prefixM Id
    id_)
            pure (extendVarEnv id_ nm env_)

    -- | Generate names for top entities. Should be executed at the very start of
    -- the synthesis process and shared between all passes.
    genTopNames
      :: ClashOpts
      -> HDL
      -- ^ HDL to generate identifiers for
      -> [TopEntityT]
      -> (VarEnv Identifier, IdentifierSet)
    genTopNames :: ClashOpts
    -> HDL -> [TopEntityT] -> (VarEnv Identifier, IdentifierSet)
    genTopNames ClashOpts
    opts HDL
    hdl [TopEntityT]
    tops =
      -- TODO: Report error if fixed top entities have conflicting names
      (State IdentifierSet (VarEnv Identifier)
     -> IdentifierSet -> (VarEnv Identifier, IdentifierSet))
    -> IdentifierSet
    -> State IdentifierSet (VarEnv Identifier)
    -> (VarEnv Identifier, IdentifierSet)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip State IdentifierSet (VarEnv Identifier)
    -> IdentifierSet -> (VarEnv Identifier, IdentifierSet)
    forall s a. State s a -> s -> (a, s)
    runState (Bool -> PreserveCase -> HDL -> IdentifierSet
    Id.emptyIdentifierSet Bool
    esc PreserveCase
    lw HDL
    hdl) (State IdentifierSet (VarEnv Identifier)
     -> (VarEnv Identifier, IdentifierSet))
    -> State IdentifierSet (VarEnv Identifier)
    -> (VarEnv Identifier, IdentifierSet)
    forall a b. (a -> b) -> a -> b
    $ do
        env0 <- (VarEnv Identifier
     -> (Id, TopEntity) -> State IdentifierSet (VarEnv Identifier))
    -> VarEnv Identifier
    -> [(Id, TopEntity)]
    -> State IdentifierSet (VarEnv Identifier)
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM VarEnv Identifier
    -> (Id, TopEntity) -> State IdentifierSet (VarEnv Identifier)
    forall {m :: Type -> Type} {b}.
    IdentifierSetMonad m =>
    VarEnv Identifier -> (Var b, TopEntity) -> m (VarEnv Identifier)
    goFixed VarEnv Identifier
    forall a. VarEnv a
    emptyVarEnv [(Id, TopEntity)]
    fixedTops
        env1 <- foldlM goNonFixed env0 nonFixedTops
        pure env1
     where
      prefixM :: Maybe Text
    prefixM = ClashOpts -> Maybe Text
    opt_componentPrefix ClashOpts
    opts
      esc :: Bool
    esc = ClashOpts -> Bool
    opt_escapedIds ClashOpts
    opts
      lw :: PreserveCase
    lw = ClashOpts -> PreserveCase
    opt_lowerCaseBasicIds ClashOpts
    opts

      fixedTops :: [(Id, TopEntity)]
    fixedTops = [(Id
    topId, TopEntity
    ann) | TopEntityT{Id
    topId :: Id
    topId :: TopEntityT -> Id
    topId, topAnnotation :: TopEntityT -> Maybe TopEntity
    topAnnotation=Just TopEntity
    ann} <- [TopEntityT]
    tops]
      nonFixedTops :: [Id]
    nonFixedTops = [Id
    topId | TopEntityT{Id
    topId :: TopEntityT -> Id
    topId :: Id
    topId, topAnnotation :: TopEntityT -> Maybe TopEntity
    topAnnotation=Maybe TopEntity
    Nothing} <- [TopEntityT]
    tops]

      goFixed :: VarEnv Identifier -> (Var b, TopEntity) -> m (VarEnv Identifier)
    goFixed VarEnv Identifier
    env (Var b
    topId, TopEntity
    ann) = do
        topNm <- Maybe Text -> TopEntity -> m Identifier
    forall (m :: Type -> Type).
    IdentifierSetMonad m =>
    Maybe Text -> TopEntity -> m Identifier
    genTopName Maybe Text
    prefixM TopEntity
    ann
        pure (extendVarEnv topId topNm env)

      goNonFixed :: VarEnv Identifier -> Id -> m (VarEnv Identifier)
    goNonFixed VarEnv Identifier
    env Id
    id_ = do
        topNm <- Text -> m Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic (Bool -> Maybe Text -> Id -> Text
    genComponentName Bool
    True Maybe Text
    prefixM Id
    id_)
        pure (extendVarEnv id_ topNm env)

    -- | Generate a component for a given function (caching)
    genComponent
      :: HasCallStack
      => Id
      -- ^ Name of the function
      -> NetlistMonad (ComponentMeta, Component)
    genComponent :: HasCallStack => Id -> NetlistMonad (ComponentMeta, Component)
    genComponent Id
    compName = do
      compExprM <- Id -> BindingMap -> Maybe (Binding Term)
    forall b a. Var b -> VarEnv a -> Maybe a
    lookupVarEnv Id
    compName (BindingMap -> Maybe (Binding Term))
    -> NetlistMonad BindingMap -> NetlistMonad (Maybe (Binding Term))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> 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 compExprM of
        Maybe (Binding Term)
    Nothing -> 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
          throw (ClashException sp ($(curLoc) ++ "No normalized expression found for: " ++ show compName) Nothing)
        Just Binding Term
    b -> do
          Id
    -> Lens' NetlistState ComponentMap
    -> NetlistMonad (ComponentMeta, Component)
    -> NetlistMonad (ComponentMeta, Component)
    forall s (m :: Type -> Type) k v.
    (MonadState s m, Uniquable k) =>
    k -> Lens' s (OMap Unique v) -> m v -> m v
    makeCachedO Id
    compName (ComponentMap -> f ComponentMap) -> NetlistState -> f NetlistState
    Lens' NetlistState ComponentMap
    components (NetlistMonad (ComponentMeta, Component)
     -> NetlistMonad (ComponentMeta, Component))
    -> NetlistMonad (ComponentMeta, Component)
    -> NetlistMonad (ComponentMeta, Component)
    forall a b. (a -> b) -> a -> b
    $ HasCallStack =>
    Id -> Term -> NetlistMonad (ComponentMeta, Component)
    Id -> Term -> NetlistMonad (ComponentMeta, Component)
    genComponentT Id
    compName (Binding Term -> Term
    forall a. Binding a -> a
    bindingTerm Binding Term
    b)

    -- | Generate a component for a given function
    genComponentT
      :: HasCallStack
      => Id
      -- ^ Name of the function
      -> Term
      -- ^ Corresponding term
      -> NetlistMonad (ComponentMeta, Component)
    genComponentT :: HasCallStack =>
    Id -> Term -> NetlistMonad (ComponentMeta, Component)
    genComponentT Id
    compName0 Term
    componentExpr = 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
      compName1 <- (`lookupVarEnv'` compName0) <$> Lens.use componentNames
      sp <- (bindingLoc . (`lookupVarEnv'` compName0)) <$> Lens.use bindings
      curCompNm .= (compName1, sp)
      usages .= mempty

      topEntityTM <- lookupVarEnv compName0 <$> Lens.use topEntityAnns
      let topAnnMM = TopEntityT -> Maybe TopEntity
    topAnnotation (TopEntityT -> Maybe TopEntity)
    -> Maybe TopEntityT -> Maybe (Maybe TopEntity)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe TopEntityT
    topEntityTM
          topVarTypeM = ([Either TyVar Type], Type) -> Type
    forall a b. (a, b) -> b
    snd (([Either TyVar Type], Type) -> Type)
    -> (TopEntityT -> ([Either TyVar Type], Type))
    -> TopEntityT
    -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyConMap -> Type -> ([Either TyVar Type], Type)
    splitCoreFunForallTy TyConMap
    tcm (Type -> ([Either TyVar Type], Type))
    -> (TopEntityT -> Type)
    -> TopEntityT
    -> ([Either TyVar Type], Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf (Id -> Type) -> (TopEntityT -> Id) -> TopEntityT -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TopEntityT -> Id
    topId (TopEntityT -> Type) -> Maybe TopEntityT -> Maybe Type
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe TopEntityT
    topEntityTM

      seenIds <~ Lens.use seenComps
      (wereVoids,compInps,argWrappers,compOutps,resUnwrappers,binders,resultM) <-
        case splitNormalized tcm componentExpr of
          Right ([Id]
    args, [LetBinding]
    binds, Id
    res) -> do
            let varType1 :: Type
    varType1 = Type -> Maybe Type -> Type
    forall a. a -> Maybe a -> a
    fromMaybe (Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf Id
    res) Maybe Type
    topVarTypeM
            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
    emptyInScopeSet
              Maybe (Maybe TopEntity)
    topAnnMM
              -- HACK: Determine resulttype of this function by looking at its definition
              -- instead of looking at its last binder (which obscures any attributes
              -- [see: Clash.Annotations.SynthesisAttributes]).
              (([Id]
    args, [LetBinding]
    binds, Id
    res{varType=varType1}))
          Left [Char]
    err ->
            ClashException
    -> NetlistMonad
         ([Bool], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($[Char]
    curLoc [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err) Maybe [Char]
    forall a. Maybe a
    Nothing)

      netDecls <- concatMapM mkNetDecl (filter (maybe (const True) (/=) resultM . fst) binders)
      decls    <- concat <$> mapM (uncurry mkDeclarations) binders

      case resultM of
        Just Id
    result -> do
          [NetDecl' _ _ _ rIM] <- case (LetBinding -> Bool) -> [LetBinding] -> [LetBinding]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Id
    result) (Id -> Bool) -> (LetBinding -> Id) -> LetBinding -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LetBinding -> Id
    forall a b. (a, b) -> a
    fst) [LetBinding]
    binders of
            LetBinding
    b:[LetBinding]
    _ -> LetBinding -> NetlistMonad [Declaration]
    mkNetDecl LetBinding
    b
            [LetBinding]
    _ -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: couldn't find result binder"

          u <- Lens.use usages
          let useOf (Identifier, b)
    i = Usage -> Maybe Usage -> Usage
    forall a. a -> Maybe a -> a
    fromMaybe Usage
    Cont (Maybe Usage -> Usage) -> Maybe Usage -> Usage
    forall a b. (a -> b) -> a -> b
    $ Identifier -> UsageMap -> Maybe Usage
    lookupUsage ((Identifier, b) -> Identifier
    forall a b. (a, b) -> a
    fst (Identifier, b)
    i) UsageMap
    u

          let (compOutps',resUnwrappers') = case compOutps of
                [(Identifier, HWType)
    oport] -> ([((Identifier, HWType) -> Usage
    forall {b}. (Identifier, b) -> Usage
    useOf (Identifier, HWType)
    oport,(Identifier, HWType)
    oport,Maybe Expr
    rIM)],[Declaration]
    resUnwrappers)
                [(Identifier, HWType)]
    _ -> case [Declaration]
    resUnwrappers of
                  NetDecl Maybe Text
    n Identifier
    res HWType
    resTy:[Declaration]
    _ ->
                    (((Identifier, HWType) -> (Usage, (Identifier, HWType), Maybe Expr))
    -> [(Identifier, HWType)]
    -> [(Usage, (Identifier, HWType), Maybe Expr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Identifier, HWType)
    op -> ((Identifier, HWType) -> Usage
    forall {b}. (Identifier, b) -> Usage
    useOf (Identifier, HWType)
    op,(Identifier, HWType)
    op,Maybe Expr
    forall a. Maybe a
    Nothing)) [(Identifier, HWType)]
    compOutps
                    ,Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    n Identifier
    res HWType
    resTy Maybe Expr
    forall a. Maybe a
    NothingDeclaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :Int -> [Declaration] -> [Declaration]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [Declaration]
    resUnwrappers
                    )
                  [Declaration]
    _ -> [Char]
    -> ([(Usage, (Identifier, HWType), Maybe Expr)], [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient resUnwrappers"
              component      = Identifier
    -> [(Identifier, HWType)]
    -> [(Usage, (Identifier, HWType), Maybe Expr)]
    -> [Declaration]
    -> Component
    Component Identifier
    compName1 [(Identifier, HWType)]
    compInps [(Usage, (Identifier, HWType), Maybe Expr)]
    compOutps'
                                 ([Declaration]
    netDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    argWrappers [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    decls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    resUnwrappers')
          ids <- Lens.use seenIds
          return (ComponentMeta wereVoids sp ids u, component)
        -- No result declaration means that the result is empty, this only happens
        -- when the TopEntity has an empty result. We just create an empty component
        -- in this case.
        Maybe Id
    Nothing -> do
          let component :: Component
    component = Identifier
    -> [(Identifier, HWType)]
    -> [(Usage, (Identifier, HWType), Maybe Expr)]
    -> [Declaration]
    -> Component
    Component Identifier
    compName1 [(Identifier, HWType)]
    compInps [] ([Declaration]
    netDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    argWrappers [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    decls)
          ids <- Getting IdentifierSet NetlistState IdentifierSet
    -> NetlistMonad IdentifierSet
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting IdentifierSet NetlistState IdentifierSet
    Lens' NetlistState IdentifierSet
    seenIds
          u <- Lens.use usages
          return (ComponentMeta wereVoids sp ids u, component)

    mkNetDecl :: (Id, Term) -> NetlistMonad [Declaration]
    mkNetDecl :: LetBinding -> NetlistMonad [Declaration]
    mkNetDecl (Id
    id_,Term
    tm) = NetlistMonad [Declaration] -> NetlistMonad [Declaration]
    forall a. NetlistMonad a -> NetlistMonad a
    preserveVarEnv (NetlistMonad [Declaration] -> NetlistMonad [Declaration])
    -> NetlistMonad [Declaration] -> NetlistMonad [Declaration]
    forall a b. (a -> b) -> a -> b
    $ do
      hwTy <- [Char] -> Type -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' $(curLoc) (Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf Id
    id_)

      if | not (shouldRenderDecl hwTy tm) -> return []
         | (Prim pInfo@PrimInfo{primMultiResult=MultiResult}, args) <- collectArgs tm ->
              multiDecls pInfo args
         | otherwise -> pure <$> singleDecl hwTy

      where
        multiDecls :: PrimInfo -> [Either Term Type] -> NetlistMonad [Declaration]
    multiDecls PrimInfo
    pInfo [Either Term Type]
    args0 = 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
          resInits0 <- getResInits (id_, tm)
          let
            resInits1 = (Expr -> Maybe Expr) -> [Expr] -> [Maybe Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map Expr -> Maybe Expr
    forall a. a -> Maybe a
    Just [Expr]
    resInits0 [Maybe Expr] -> [Maybe Expr] -> [Maybe Expr]
    forall a. Semigroup a => a -> a -> a
    <> Maybe Expr -> [Maybe Expr]
    forall a. a -> [a]
    repeat Maybe Expr
    forall a. Maybe a
    Nothing
            mpInfo = HasCallStack => TyConMap -> PrimInfo -> MultiPrimInfo
    TyConMap -> PrimInfo -> MultiPrimInfo
    multiPrimInfo' TyConMap
    tcm PrimInfo
    pInfo
            (_, res) = splitMultiPrimArgs mpInfo args0

            netdecl Id
    i HWType
    typ Maybe Expr
    resInit =
              Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    srcNote (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    i) HWType
    typ Maybe Expr
    resInit

          hwTys <- mapM (unsafeCoreTypeToHWTypeM' $(curLoc)) (mpi_resultTypes mpInfo)
          pure (zipWith3 netdecl res hwTys resInits1)

        singleDecl :: HWType -> NetlistMonad Declaration
    singleDecl HWType
    hwTy = do
          rIM <- [Expr] -> Maybe Expr
    forall a. [a] -> Maybe a
    listToMaybe ([Expr] -> Maybe Expr)
    -> NetlistMonad [Expr] -> NetlistMonad (Maybe Expr)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> LetBinding -> NetlistMonad [Expr]
    getResInits (Id
    id_, Term
    tm)
          return (NetDecl' srcNote (Id.unsafeFromCoreId id_) hwTy rIM)

        addSrcNote :: SrcSpan -> Maybe Text
    addSrcNote SrcSpan
    loc
          | SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    loc = Text -> Maybe Text
    forall a. a -> Maybe a
    Just ([Char] -> Text
    StrictText.pack (SDoc -> [Char]
    showSDocUnsafe (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    loc)))
          | Bool
    otherwise = Maybe Text
    forall a. Maybe a
    Nothing

        srcNote :: Maybe Text
    srcNote = SrcSpan -> Maybe Text
    addSrcNote (SrcSpan -> Maybe Text) -> SrcSpan -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ case Term
    tm of
          Tick (SrcSpan SrcSpan
    s) Term
    _ -> SrcSpan
    s
          Term
    _ -> Name Term -> SrcSpan
    forall a. Name a -> SrcSpan
    nameLoc (Id -> Name Term
    forall a. Var a -> Name a
    varName Id
    id_)

        isMultiPrimSelect :: Term -> Bool
        isMultiPrimSelect :: Term -> Bool
    isMultiPrimSelect Term
    t = case Term -> (Term, [Either Term Type])
    collectArgs Term
    t of
          (Prim (PrimInfo -> Text
    primName -> Text
    "c$multiPrimSelect"), [Either Term Type]
    _) -> Bool
    True
          (Term, [Either Term Type])
    _ -> Bool
    False

        shouldRenderDecl :: HWType -> Term -> Bool
        shouldRenderDecl :: HWType -> Term -> Bool
    shouldRenderDecl HWType
    ty Term
    t
          | HWType -> Bool
    isVoid HWType
    ty = Bool
    False
          | Term -> Bool
    isMultiPrimSelect Term
    t = Bool
    False
          | Bool
    otherwise = Bool
    True

        -- Set the initialization value of a signal when a primitive wants to set it
        getResInits :: (Id, Term) -> NetlistMonad [Expr]
        getResInits :: LetBinding -> NetlistMonad [Expr]
    getResInits (Id
    i,Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks -> (Term
    k,[Either Term Type]
    args0,[TickInfo]
    ticks)) = case Term
    k of
          Prim PrimInfo
    p -> HasCallStack => Text -> NetlistMonad CompiledPrimitive
    Text -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail (PrimInfo -> Text
    primName PrimInfo
    p) NetlistMonad CompiledPrimitive
    -> (CompiledPrimitive -> NetlistMonad [Expr])
    -> NetlistMonad [Expr]
    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
    >>= PrimInfo -> CompiledPrimitive -> NetlistMonad [Expr]
    forall {a} {c} {d}.
    PrimInfo -> Primitive a BlackBox c d -> NetlistMonad [Expr]
    go PrimInfo
    p
          Term
    _ -> [Expr] -> NetlistMonad [Expr]
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return []
         where
          go :: PrimInfo -> Primitive a BlackBox c d -> NetlistMonad [Expr]
    go PrimInfo
    pInfo (BlackBox {resultInits :: forall a b c d. Primitive a b c d -> [b]
    resultInits=[BlackBox]
    nmDs, multiResult :: forall a b c d. Primitive a b c d -> Bool
    multiResult=Bool
    True}) = [TickInfo]
    -> ([Declaration] -> NetlistMonad [Expr]) -> NetlistMonad [Expr]
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (([Declaration] -> NetlistMonad [Expr]) -> NetlistMonad [Expr])
    -> ([Declaration] -> NetlistMonad [Expr]) -> NetlistMonad [Expr]
    forall a b. (a -> b) -> a -> b
    $ \[Declaration]
    _ -> 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 (args1, res) = splitMultiPrimArgs (multiPrimInfo' tcm pInfo) args0
            (bbCtx, _) <- mkBlackBoxContext (primName pInfo) Concurrent res args1
            mapM (go' (primName pInfo) bbCtx) nmDs
          go PrimInfo
    pInfo (BlackBox {resultInits :: forall a b c d. Primitive a b c d -> [b]
    resultInits=[BlackBox]
    nmDs}) = [TickInfo]
    -> ([Declaration] -> NetlistMonad [Expr]) -> NetlistMonad [Expr]
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (([Declaration] -> NetlistMonad [Expr]) -> NetlistMonad [Expr])
    -> ([Declaration] -> NetlistMonad [Expr]) -> NetlistMonad [Expr]
    forall a b. (a -> b) -> a -> b
    $ \[Declaration]
    _ -> do
            (bbCtx, _) <- 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
    Concurrent [Id
    i] [Either Term Type]
    args0
            mapM (go' (primName pInfo) bbCtx) nmDs
          go PrimInfo
    _ Primitive a BlackBox c d
    _ = [Expr] -> NetlistMonad [Expr]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []

          go' :: Text -> BlackBoxContext -> BlackBox -> NetlistMonad Expr
    go' Text
    pNm BlackBoxContext
    bbCtx BlackBox
    nmD = do
            (bbTempl, templDecl) <- Text
    -> BlackBox
    -> BlackBoxContext
    -> NetlistMonad (BlackBox, [Declaration])
    prepareBlackBox Text
    pNm BlackBox
    nmD BlackBoxContext
    bbCtx
            case templDecl of
              [] ->
                Expr -> NetlistMonad Expr
    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
    pNm [] [] [] BlackBox
    bbTempl BlackBoxContext
    bbCtx Bool
    False)
              [Declaration]
    _  -> do
                (_,sloc) <- 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 sloc [I.i|
                  Initial values cannot produce declarations, but saw:

                    #{templDecl}

                  after rendering initial values for blackbox:

                    #{pNm}

                  Given template:

                    #{nmD}
                |] Nothing)

    -- | Generate a list of concurrent Declarations for a let-binder, return an
    -- empty list if the bound expression is represented by 0 bits
    mkDeclarations
      :: HasCallStack
      => Id
      -- ^ LHS of the let-binder
      -> Term
      -- ^ RHS of the let-binder
      -> NetlistMonad [Declaration]
    mkDeclarations :: HasCallStack => Id -> Term -> NetlistMonad [Declaration]
    mkDeclarations = HasCallStack =>
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    mkDeclarations' DeclarationType
    Concurrent

    -- | Generate a list of Declarations for a let-binder, return an empty list if
    -- the bound expression is represented by 0 bits
    mkDeclarations'
      :: HasCallStack
      => DeclarationType
      -- ^ Concurrent of sequential declaration
      -> Id
      -- ^ LHS of the let-binder
      -> Term
      -- ^ RHS of the let-binder
      -> NetlistMonad [Declaration]
    mkDeclarations' :: HasCallStack =>
    DeclarationType -> Id -> Term -> NetlistMonad [Declaration]
    mkDeclarations' DeclarationType
    declType Id
    bndr (Term -> (Term, [TickInfo])
    collectTicks -> (Var Id
    v,[TickInfo]
    ticks)) =
      [TickInfo]
    -> ([Declaration] -> NetlistMonad [Declaration])
    -> NetlistMonad [Declaration]
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (HasCallStack =>
    DeclarationType
    -> Identifier
    -> Id
    -> [Term]
    -> [Declaration]
    -> NetlistMonad [Declaration]
    DeclarationType
    -> Identifier
    -> Id
    -> [Term]
    -> [Declaration]
    -> NetlistMonad [Declaration]
    mkFunApp DeclarationType
    declType (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    bndr) Id
    v [])

    mkDeclarations' DeclarationType
    _declType Id
    _bndr e :: Term
    e@(Term -> (Term, [TickInfo])
    collectTicks -> (Case Term
    _ Type
    _ [],[TickInfo]
    _)) = 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
      throw $ ClashException
              sp
              ( unwords [ $(curLoc)
                        , "Not in normal form: Case-decompositions with an"
                        , "empty list of alternatives not supported:\n\n"
                        , showPpr e
                        ])
              Nothing

    mkDeclarations' DeclarationType
    declType Id
    bndr (Term -> (Term, [TickInfo])
    collectTicks -> (Case Term
    scrut Type
    altTy ((Pat, Term)
    alt:alts :: [(Pat, Term)]
    alts@((Pat, Term)
    _:[(Pat, Term)]
    _)),[TickInfo]
    ticks)) =
      [TickInfo]
    -> ([Declaration] -> NetlistMonad [Declaration])
    -> NetlistMonad [Declaration]
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (DeclarationType
    -> NetlistId
    -> Term
    -> Type
    -> NonEmpty (Pat, Term)
    -> [Declaration]
    -> NetlistMonad [Declaration]
    mkSelection DeclarationType
    declType (Id -> NetlistId
    CoreId Id
    bndr) Term
    scrut Type
    altTy ((Pat, Term)
    alt (Pat, Term) -> [(Pat, Term)] -> NonEmpty (Pat, Term)
    forall a. a -> [a] -> NonEmpty a
    :| [(Pat, Term)]
    alts))

    mkDeclarations' DeclarationType
    declType Id
    bndr Term
    app = do
      let (Term
    appF,[Either Term Type]
    args0,[TickInfo]
    ticks) = Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks Term
    app
          ([Term]
    args,[Type]
    tyArgs) = [Either Term Type] -> ([Term], [Type])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Term Type]
    args0
      case Term
    appF of
        Var Id
    f
          | [Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [Type]
    tyArgs ->
            [TickInfo]
    -> ([Declaration] -> NetlistMonad [Declaration])
    -> NetlistMonad [Declaration]
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (HasCallStack =>
    DeclarationType
    -> Identifier
    -> Id
    -> [Term]
    -> [Declaration]
    -> NetlistMonad [Declaration]
    DeclarationType
    -> Identifier
    -> Id
    -> [Term]
    -> [Declaration]
    -> NetlistMonad [Declaration]
    mkFunApp DeclarationType
    declType (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    bndr) Id
    f [Term]
    args)
          | Bool
    otherwise   -> 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
            throw (ClashException sp ($(curLoc) ++ "Not in normal form: Var-application with Type arguments:\n\n" ++ showPpr app) Nothing)
        Term
    _ -> do
          (exprApp,declsApp0) <- HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    False DeclarationType
    declType (Id -> NetlistId
    CoreId Id
    bndr) Term
    app
          let dstId = HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    bndr
          assn  <- case exprApp of
                     Identifier Identifier
    _ Maybe Modifier
    Nothing ->
                       -- Supplied 'bndr' was used to assign a result to, so we
                       -- don't have to manually turn it into a declaration
                       [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []

                     Expr
    Noop ->
                       -- Rendered expression rendered a "noop" - a list of
                       -- declarations without a result. Used for things like
                       -- mealy IO / inline assertions / multi result primitives.
                       [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []

                     Expr
    _ -> do
                       -- Turn returned expression into declaration by assigning
                       -- it to 'dstId'
                       assn <- case DeclarationType
    declType of
                         DeclarationType
    Concurrent -> HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    dstId Expr
    exprApp
                         DeclarationType
    Sequential -> HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    dstId Expr
    exprApp
                       pure [assn]

          declsApp1 <- if null declsApp0
                       then withTicks ticks return
                       else pure declsApp0
          return (declsApp1 ++ assn)

    -- | Generate a declaration that selects an alternative based on the value of
    -- the scrutinee
    mkSelection
      :: DeclarationType
      -> NetlistId
      -> Term
      -> Type
      -> NonEmpty Alt
      -> [Declaration]
      -> NetlistMonad [Declaration]
    mkSelection :: DeclarationType
    -> NetlistId
    -> Term
    -> Type
    -> NonEmpty (Pat, Term)
    -> [Declaration]
    -> NetlistMonad [Declaration]
    mkSelection DeclarationType
    declType NetlistId
    bndr Term
    scrut Type
    altTy NonEmpty (Pat, Term)
    alts0 [Declaration]
    tickDecls = do
      let dstId :: Identifier
    dstId = (Identifier -> Identifier)
    -> (Id -> Identifier) -> NetlistId -> Identifier
    forall r.
    HasCallStack =>
    (Identifier -> r) -> (Id -> r) -> NetlistId -> r
    netlistId1 Identifier -> Identifier
    forall a. a -> a
    id HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId NetlistId
    bndr
      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
      scrutId  <- Id.suffix dstId "selection"
      (_,sp) <- Lens.use curCompNm
      ite <- Lens.use backEndITE
      altHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) altTy
      case iteAlts scrutHTy (NE.toList alts0) of
        Just (Term
    altT,Term
    altF)
          | Bool
    ite
          , DeclarationType
    Concurrent <- DeclarationType
    declType
          -> do
          (scrutExpr,scrutDecls) <- case HWType
    scrutHTy of
            SP {} -> (Expr -> Expr) -> (Expr, [Declaration]) -> (Expr, [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 (SrcSpan -> HWType -> Pat -> Expr -> Expr
    mkScrutExpr SrcSpan
    sp HWType
    scrutHTy ((Pat, Term) -> Pat
    forall a b. (a, b) -> a
    fst (NonEmpty (Pat, Term) -> (Pat, Term)
    forall a. NonEmpty a -> a
    NE.last NonEmpty (Pat, Term)
    alts0))) ((Expr, [Declaration]) -> (Expr, [Declaration]))
    -> NetlistMonad (Expr, [Declaration])
    -> NetlistMonad (Expr, [Declaration])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                       HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    True DeclarationType
    declType (Identifier -> Type -> NetlistId
    NetlistId Identifier
    scrutId Type
    scrutTy) Term
    scrut
            HWType
    _ -> 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
    scrutId Type
    scrutTy) Term
    scrut
          altTId <- Id.suffix dstId "sel_alt_t"
          altFId <- Id.suffix dstId "sel_alt_f"
          (altTExpr,altTDecls) <- mkExpr False declType (NetlistId altTId altTy) altT
          (altFExpr,altFDecls) <- mkExpr False declType (NetlistId altFId altTy) altF
          -- This logic (and the same logic a few lines below) is faulty in the
          -- sense that it won't generate "void decls" if the alternatives' type
          -- is void, but the type of the scrut isn't. Ideally, we'd like to pass
          -- a boolean to 'mkExpr' indicating that it should only render "void decls"
          -- but that it should skip any others.
          --
          -- TODO: Fix ^
          if | isVoid altHTy && isVoid scrutHTy
              -> return $! scrutDecls ++ altTDecls ++ altFDecls
             | isVoid altHTy
              -> return $! altTDecls ++ altFDecls
             | otherwise
              -> do dstAssign <- contAssign dstId (IfThenElse scrutExpr altTExpr altFExpr)
                    return $! scrutDecls ++ altTDecls ++ altFDecls ++ tickDecls ++ [dstAssign]
        Maybe (Term, Term)
    _ -> do
          reprs <- Getting CustomReprs NetlistEnv CustomReprs
    -> NetlistMonad CustomReprs
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting CustomReprs NetlistEnv CustomReprs
    Getter NetlistEnv CustomReprs
    customReprs
          let alts1 = (NonEmpty (Pat, Term) -> NonEmpty (Pat, Term)
    reorderDefault (NonEmpty (Pat, Term) -> NonEmpty (Pat, Term))
    -> (NonEmpty (Pat, Term) -> NonEmpty (Pat, Term))
    -> NonEmpty (Pat, Term)
    -> NonEmpty (Pat, Term)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyConMap
    -> CustomReprs
    -> Type
    -> NonEmpty (Pat, Term)
    -> NonEmpty (Pat, Term)
    reorderCustom TyConMap
    tcm CustomReprs
    reprs Type
    scrutTy) NonEmpty (Pat, Term)
    alts0
          (scrutExpr,scrutDecls) <- first (mkScrutExpr sp scrutHTy (fst (NE.head alts1))) <$>
                                      mkExpr True declType (NetlistId scrutId scrutTy) scrut
          (exprs,altsDecls)      <- unzip <$> mapM (mkCondExpr scrutHTy) (NE.toList alts1)
          case declType of
            DeclarationType
    Sequential -> do
              -- Assign to the result in every branch
              (altNets,exprAlts) <- ([([Declaration], (Maybe Literal, [Seq]))]
     -> ([[Declaration]], [(Maybe Literal, [Seq])]))
    -> NetlistMonad [([Declaration], (Maybe Literal, [Seq]))]
    -> NetlistMonad ([[Declaration]], [(Maybe Literal, [Seq])])
    forall a b. (a -> b) -> NetlistMonad a -> NetlistMonad b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap [([Declaration], (Maybe Literal, [Seq]))]
    -> ([[Declaration]], [(Maybe Literal, [Seq])])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (((Maybe Literal, Expr)
     -> [Declaration]
     -> NetlistMonad ([Declaration], (Maybe Literal, [Seq])))
    -> [(Maybe Literal, Expr)]
    -> [[Declaration]]
    -> NetlistMonad [([Declaration], (Maybe Literal, [Seq]))]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (Identifier
    -> (Maybe Literal, Expr)
    -> [Declaration]
    -> NetlistMonad ([Declaration], (Maybe Literal, [Seq]))
    altAssign Identifier
    dstId) [(Maybe Literal, Expr)]
    exprs [[Declaration]]
    altsDecls)
              return $! scrutDecls ++ tickDecls ++ concat altNets ++
                        [Seq [Branch scrutExpr scrutHTy exprAlts]]
            DeclarationType
    Concurrent ->
              if | HWType -> Bool
    isVoid HWType
    altHTy Bool -> Bool -> Bool
    && HWType -> Bool
    isVoid HWType
    scrutHTy
                  -> [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([Declaration] -> NetlistMonad [Declaration])
    -> [Declaration] -> NetlistMonad [Declaration]
    forall a b. (a -> b) -> a -> b
    $! [[Declaration]] -> [Declaration]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[Declaration]]
    altsDecls [Declaration] -> [Declaration] -> [Declaration]
    forall a. [a] -> [a] -> [a]
    ++ [Declaration]
    scrutDecls
                 | HWType -> Bool
    isVoid HWType
    altHTy
                  -> [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([Declaration] -> NetlistMonad [Declaration])
    -> [Declaration] -> NetlistMonad [Declaration]
    forall a b. (a -> b) -> a -> b
    $! [[Declaration]] -> [Declaration]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[Declaration]]
    altsDecls
                 | Bool
    otherwise
                  -> do assign <- Identifier
    -> HWType
    -> Expr
    -> HWType
    -> [(Maybe Literal, Expr)]
    -> NetlistMonad Declaration
    condAssign Identifier
    dstId HWType
    altHTy Expr
    scrutExpr HWType
    scrutHTy [(Maybe Literal, Expr)]
    exprs
                        return $! scrutDecls ++ concat altsDecls ++ tickDecls ++ [assign]
     where
      mkCondExpr :: HWType -> (Pat,Term) -> NetlistMonad ((Maybe HW.Literal,Expr),[Declaration])
      mkCondExpr :: HWType
    -> (Pat, Term)
    -> NetlistMonad ((Maybe Literal, Expr), [Declaration])
    mkCondExpr HWType
    scrutHTy (Pat
    pat,Term
    alt) = do
        altId <- Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix ((Identifier -> Identifier)
    -> (Id -> Identifier) -> NetlistId -> Identifier
    forall r.
    HasCallStack =>
    (Identifier -> r) -> (Id -> r) -> NetlistId -> r
    netlistId1 Identifier -> Identifier
    forall a. a -> a
    id HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId NetlistId
    bndr) Text
    "sel_alt"
        (altExpr,altDecls) <- mkExpr False declType (NetlistId altId altTy) alt
        (,altDecls) <$> case pat of
          Pat
    DefaultPat           -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Maybe Literal
    forall a. Maybe a
    Nothing,Expr
    altExpr)
          DataPat DataCon
    dc [TyVar]
    _ [Id]
    _ -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (HWType -> Int -> Literal
    dcToLiteral HWType
    scrutHTy (DataCon -> Int
    dcTag DataCon
    dc)),Expr
    altExpr)
          LitPat  (IntegerLiteral Integer
    i) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    i),Expr
    altExpr)
          LitPat  (IntLiteral Integer
    i) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    i), Expr
    altExpr)
          LitPat  (WordLiteral Integer
    w) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    w), Expr
    altExpr)
          LitPat  (CharLiteral Char
    c) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Literal) -> Int -> Literal
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c), Expr
    altExpr)
          LitPat  (Int64Literal Integer
    i) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    i), Expr
    altExpr)
          LitPat  (Word64Literal Integer
    w) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    w), Expr
    altExpr)
    #if MIN_VERSION_base(4,16,0)
          LitPat  (Int8Literal Integer
    i) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    i), Expr
    altExpr)
          LitPat  (Int16Literal Integer
    i) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    i), Expr
    altExpr)
          LitPat  (Int32Literal Integer
    i) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    i), Expr
    altExpr)
          LitPat  (Word8Literal Integer
    w) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    w), Expr
    altExpr)
          LitPat  (Word16Literal Integer
    w) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    w), Expr
    altExpr)
          LitPat  (Word32Literal Integer
    w) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    w), Expr
    altExpr)
    #endif
          LitPat  (NaturalLiteral Integer
    n) -> (Maybe Literal, Expr) -> NetlistMonad (Maybe Literal, Expr)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Integer -> Literal
    NumLit Integer
    n), Expr
    altExpr)
          Pat
    _  -> 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
            throw (ClashException sp ($(curLoc) ++ "Not an integer literal in LitPat:\n\n" ++ showPpr pat) Nothing)

      mkScrutExpr :: SrcSpan -> HWType -> Pat -> Expr -> Expr
      mkScrutExpr :: SrcSpan -> HWType -> Pat -> Expr -> Expr
    mkScrutExpr SrcSpan
    sp HWType
    scrutHTy Pat
    pat Expr
    scrutE = case Pat
    pat of
        DataPat DataCon
    dc [TyVar]
    _ [Id]
    _ -> let modifier :: Maybe Modifier
    modifier = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int) -> Modifier
    DC (HWType
    scrutHTy,DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                          in case Expr
    scrutE of
                              Identifier Identifier
    scrutId Maybe Modifier
    Nothing -> Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    scrutId Maybe Modifier
    modifier
                              Expr
    _ -> ClashException -> Expr
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: Not a variable reference or primitive as subject of a case-statement:\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Expr -> [Char]
    forall a. Show a => a -> [Char]
    show Expr
    scrutE) Maybe [Char]
    forall a. Maybe a
    Nothing)
        Pat
    _ -> Expr
    scrutE

      altAssign
        :: Identifier
        -> (Maybe HW.Literal,Expr)
        -> [Declaration]
        -> NetlistMonad ([Declaration],(Maybe HW.Literal,[Seq]))
      altAssign :: Identifier
    -> (Maybe Literal, Expr)
    -> [Declaration]
    -> NetlistMonad ([Declaration], (Maybe Literal, [Seq]))
    altAssign Identifier
    i (Maybe Literal
    m,Expr
    expr) [Declaration]
    ds = do
        let ([Declaration]
    nets,[Declaration]
    rest) = (Declaration -> Bool)
    -> [Declaration] -> ([Declaration], [Declaration])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Declaration -> Bool
    isNet [Declaration]
    ds
        assn <- case Expr
    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 assn <- HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    i Expr
    expr
                          pure [assn]
        pure (nets,(m,map SeqDecl (rest ++ assn)))
       where
        isNet :: Declaration -> Bool
    isNet NetDecl' {} = Bool
    True
        isNet Declaration
    _ = Bool
    False

    -- GHC puts default patterns in the first position, we want them in the
    -- last position.
    reorderDefault
      :: NonEmpty (Pat, Term)
      -> NonEmpty (Pat, Term)
    reorderDefault :: NonEmpty (Pat, Term) -> NonEmpty (Pat, Term)
    reorderDefault ((Pat
    DefaultPat,Term
    e) :| [(Pat, Term)]
    alts') =
      case [(Pat, Term)]
    alts' of
        [] -> (Pat
    DefaultPat,Term
    e) (Pat, Term) -> [(Pat, Term)] -> NonEmpty (Pat, Term)
    forall a. a -> [a] -> NonEmpty a
    :| []
        (Pat, Term)
    x:[(Pat, Term)]
    xs -> (Pat, Term)
    x (Pat, Term) -> [(Pat, Term)] -> NonEmpty (Pat, Term)
    forall a. a -> [a] -> NonEmpty a
    :| ([(Pat, Term)]
    xs [(Pat, Term)] -> [(Pat, Term)] -> [(Pat, Term)]
    forall a. Semigroup a => a -> a -> a
    <> [(Pat
    DefaultPat,Term
    e)])
    reorderDefault NonEmpty (Pat, Term)
    alts' = NonEmpty (Pat, Term)
    alts'

    reorderCustom
      :: TyConMap
      -> CustomReprs
      -> Type
      -> NonEmpty (Pat, Term)
      -> NonEmpty (Pat, Term)
    reorderCustom :: TyConMap
    -> CustomReprs
    -> Type
    -> NonEmpty (Pat, Term)
    -> NonEmpty (Pat, Term)
    reorderCustom TyConMap
    tcm CustomReprs
    reprs (TyConMap -> Type -> Maybe Type
    coreView1 TyConMap
    tcm -> Just Type
    ty) NonEmpty (Pat, Term)
    alts =
      TyConMap
    -> CustomReprs
    -> Type
    -> NonEmpty (Pat, Term)
    -> NonEmpty (Pat, Term)
    reorderCustom TyConMap
    tcm CustomReprs
    reprs Type
    ty NonEmpty (Pat, Term)
    alts
    reorderCustom TyConMap
    _tcm CustomReprs
    reprs (Type -> Either [Char] Type'
    coreToType' -> Right Type'
    typeName) NonEmpty (Pat, Term)
    alts =
      case Type' -> CustomReprs -> Maybe DataRepr'
    getDataRepr Type'
    typeName CustomReprs
    reprs of
        Just (DataRepr' Type'
    _name Int
    _size [ConstrRepr']
    _constrReprs) ->
          ((Pat, Term) -> Int)
    -> NonEmpty (Pat, Term) -> NonEmpty (Pat, Term)
    forall b a. Ord b => (a -> b) -> NonEmpty a -> NonEmpty a
    NE.sortOn (CustomReprs -> Pat -> Int
    patPos CustomReprs
    reprs (Pat -> Int) -> ((Pat, Term) -> Pat) -> (Pat, Term) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pat, Term) -> Pat
    forall a b. (a, b) -> a
    fst) NonEmpty (Pat, Term)
    alts
        Maybe DataRepr'
    Nothing ->
          NonEmpty (Pat, Term)
    alts
    reorderCustom TyConMap
    _tcm CustomReprs
    _reprs Type
    _type NonEmpty (Pat, Term)
    alts =
      NonEmpty (Pat, Term)
    alts

    patPos
      :: CustomReprs
      -> Pat
      -> Int
    patPos :: CustomReprs -> Pat -> Int
    patPos CustomReprs
    _reprs Pat
    DefaultPat = -Int
    1
    patPos CustomReprs
    _reprs (LitPat Literal
    _) = Int
    0
    patPos CustomReprs
    reprs pat :: Pat
    pat@(DataPat DataCon
    dataCon [TyVar]
    _ [Id]
    _) =
      -- We sort data patterns by their syntactical order
      let name :: Text
    name = Name DataCon -> Text
    forall a. Name a -> Text
    nameOcc (Name DataCon -> Text) -> Name DataCon -> Text
    forall a b. (a -> b) -> a -> b
    $ DataCon -> Name DataCon
    dcName DataCon
    dataCon in
      case Text -> CustomReprs -> Maybe ConstrRepr'
    getConstrRepr Text
    name CustomReprs
    reprs of
        Maybe ConstrRepr'
    Nothing ->
          -- TODO: err
          [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Int) -> [Char] -> Int
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Pat -> [Char]
    forall a. Show a => a -> [Char]
    show Pat
    pat)
        Just (ConstrRepr' Text
    _name Int
    n Integer
    _mask Integer
    _value [Integer]
    _anns) ->
          Int
    n

    -- | Generate a list of Declarations for a let-binder where the RHS is a function application
    mkFunApp
      :: HasCallStack
      => DeclarationType
      -> Identifier -- ^ LHS of the let-binder
      -> Id -- ^ Name of the applied function
      -> [Term] -- ^ Function arguments
      -> [Declaration] -- ^ Tick declarations
      -> NetlistMonad [Declaration]
    mkFunApp :: HasCallStack =>
    DeclarationType
    -> Identifier
    -> Id
    -> [Term]
    -> [Declaration]
    -> NetlistMonad [Declaration]
    mkFunApp DeclarationType
    declType Identifier
    dstId Id
    fun [Term]
    args [Declaration]
    tickDecls = 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
      tcm     <- Lens.view tcCache
      case (isGlobalId fun, lookupVarEnv fun topAnns) of
        (Bool
    True, Just TopEntityT
    topEntity)
          | let ty :: Type
    ty = Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf (TopEntityT -> Id
    topId TopEntityT
    topEntity)
          , let ([Either TyVar Type]
    fArgTys0,Type
    fResTy) = Type -> ([Either TyVar Type], Type)
    splitFunForallTy Type
    ty
          -- Take into account that clocks and stuff are split off from any product
          -- types containing them
          , let fArgTys1 :: [Type]
    fArgTys1 = TyConMap -> [Type] -> [Type]
    splitShouldSplit TyConMap
    tcm ([Type] -> [Type]) -> [Type] -> [Type]
    forall a b. (a -> b) -> a -> b
    $ [Either TyVar Type] -> [Type]
    forall a b. [Either a b] -> [b]
    rights [Either TyVar Type]
    fArgTys0
          , [Type] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Type]
    fArgTys1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Term] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Term]
    args
          -> do
            argHWTys <- (Type -> NetlistMonad HWType) -> [Type] -> 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]
    fArgTys1
            (argExprs, concat -> argDecls) <- unzip <$>
              mapM (\(Term
    e,Type
    t) -> 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
    dstId Type
    t) Term
    e)
                                     (zip args fArgTys1)

            -- Filter void arguments, but make sure to render their declarations:
            let
              filteredTypeExprs = ((Expr, HWType) -> Bool) -> [(Expr, HWType)] -> [(Expr, HWType)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((Expr, HWType) -> Bool) -> (Expr, HWType) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HWType -> Bool
    isVoid (HWType -> Bool)
    -> ((Expr, HWType) -> HWType) -> (Expr, HWType) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Expr, HWType) -> HWType
    forall a b. (a, b) -> b
    snd) ([Expr] -> [HWType] -> [(Expr, HWType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Expr]
    argExprs [HWType]
    argHWTys)

            dstHWty  <- unsafeCoreTypeToHWTypeM' $(curLoc) fResTy

            -- TODO: The commented code fetches the function definition from the
            --       set of global bindings and uses it to replicate the port names
            --       of it. However, this does rely on the binding actually being
            --       present in the binding map. This isn't the case, as only
            --       the current top entity (and its dependencies, stopping at other
            --       top entities) are present. We can't add the non-normalized
            --       version, as this logic relies on 'splitArguments' having
            --       fired. Adding normalized versions would create a dependency
            --       between two top entities, defeating the ability to compile in
            --       parallel.
            --
            --       One option is to split the normalization process into two
            --       chunks: preprocessing (e.g., 'splitArguments') and actually
            --       normalizing. This would ensure only minimal work is being done
            --       serially.
            --
            --       The current workaround is to not rely on named arguments, using
            --       positional ones instead when instantiating a top entity.
            --
            -- funTerm <- fmap bindingTerm . lookupVarEnv fun <$> Lens.use bindings
            --
            -- expandedTopEntity <-
            --   case splitNormalized tcm <$> funTerm of
            --     Nothing -> error ("Internal error: could not find " <> show fun)
            --     Just (Left err) -> error ("Internal error: " <> show err)
            --     Just (Right (argIds, _binds, resId)) -> do
            --       argTys <- mapM (unsafeCoreTypeToHWTypeM $(curLoc)) (map coreTypeOf argIds)
            --       resTy <- unsafeCoreTypeToHWTypeM $(curLoc) (coreTypeOf resId)
            --       is <- Lens.use seenIds
            --       let topAnnM = topAnnotation topEntity
            --       pure (expandTopEntityOrErr is (zip argIds argTys) (resId, resTy) topAnnM)

            -- Generate ExpandedTopEntity, see TODO^
            argTys <- mapM (unsafeCoreTypeToHWTypeM $(curLoc) . inferCoreTypeOf tcm) args
            resTy <- unsafeCoreTypeToHWTypeM $(curLoc) fResTy
            let
              ettArgs = (Maybe a
    forall a. Maybe a
    Nothing,) (FilteredHWType -> (Maybe a, FilteredHWType))
    -> [FilteredHWType] -> [(Maybe a, FilteredHWType)]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [FilteredHWType]
    argTys
              ettRes = (Maybe a
    forall a. Maybe a
    Nothing, FilteredHWType
    resTy)
            expandedTopEntity <-
                expandTopEntityOrErrM ettArgs ettRes (topAnnotation topEntity)

            instDecls <-
              mkTopUnWrapper
                fun expandedTopEntity (dstId, dstHWty)
                filteredTypeExprs tickDecls

            return (argDecls ++ instDecls)

          | Bool
    otherwise -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad [Declaration])
    -> [Char] -> NetlistMonad [Declaration]
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "under-applied TopEntity: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Id -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Id
    fun
        (Bool
    True, Maybe TopEntityT
    Nothing) -> 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
            Maybe (Binding Term)
    Nothing -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [I.i|
              Internal error: unknown normalized binder:

                #{showPpr fun}
            |]
            Just (Binding{Term
    bindingTerm :: forall a. Binding a -> a
    bindingTerm :: Term
    bindingTerm}) -> do
              (_, Component compName compInps co _) <- 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 argTys = (Term -> Type) -> [Term] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm) [Term]
    args
              argHWTys <- mapM coreTypeToHWTypeM' argTys

              (argExprs, concat -> argDecls) <- unzip <$>
                mapM (\(Term
    e,Type
    t) -> 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
    dstId Type
    t) Term
    e)
                     (zip args argTys)

              -- Filter void arguments, but make sure to render their declarations:
              let
                argTypeExprs = [Maybe HWType] -> [(Expr, Type)] -> [(Maybe HWType, (Expr, Type))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Maybe HWType]
    argHWTys ([Expr] -> [Type] -> [(Expr, Type)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Expr]
    argExprs [Type]
    argTys)
                filteredTypeExprs = ((Maybe HWType, (Expr, Type)) -> (Expr, Type))
    -> [(Maybe HWType, (Expr, Type))] -> [(Expr, Type)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Maybe HWType, (Expr, Type)) -> (Expr, Type)
    forall a b. (a, b) -> b
    snd ([(Maybe HWType, (Expr, Type))] -> [(Expr, Type)])
    -> [(Maybe HWType, (Expr, Type))] -> [(Expr, Type)]
    forall a b. (a -> b) -> a -> b
    $ ((Maybe HWType, (Expr, Type)) -> Bool)
    -> [(Maybe HWType, (Expr, Type))] -> [(Maybe HWType, (Expr, Type))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((Maybe HWType, (Expr, Type)) -> Bool)
    -> (Maybe HWType, (Expr, Type))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Maybe HWType -> Bool
    isVoidMaybe Bool
    True (Maybe HWType -> Bool)
    -> ((Maybe HWType, (Expr, Type)) -> Maybe HWType)
    -> (Maybe HWType, (Expr, Type))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe HWType, (Expr, Type)) -> Maybe HWType
    forall a b. (a, b) -> a
    fst) [(Maybe HWType, (Expr, Type))]
    argTypeExprs

              let compOutp = (\(Usage
    _,(Identifier, HWType)
    x,Maybe Expr
    _) -> (Identifier, HWType)
    x) ((Usage, (Identifier, HWType), Maybe Expr) -> (Identifier, HWType))
    -> Maybe (Usage, (Identifier, HWType), Maybe Expr)
    -> Maybe (Identifier, HWType)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Usage, (Identifier, HWType), Maybe Expr)]
    -> Maybe (Usage, (Identifier, HWType), Maybe Expr)
    forall a. [a] -> Maybe a
    listToMaybe [(Usage, (Identifier, HWType), Maybe Expr)]
    co
              if length filteredTypeExprs == length compInps
                then do
                  (argExprs',argDecls') <- (second concat . unzip) <$> mapM (toSimpleVar declType dstId) filteredTypeExprs
                  let 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
    i,HWType
    t) Expr
    e -> (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    i Maybe Modifier
    forall a. Maybe a
    Nothing,PortDirection
    In,HWType
    t,Expr
    e)) [(Identifier, HWType)]
    compInps [Expr]
    argExprs'
                      outpAssign    = case Maybe (Identifier, HWType)
    compOutp of
                        Maybe (Identifier, HWType)
    Nothing -> []
                        Just (Identifier
    id_,HWType
    hwtype) -> [(Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id_ Maybe Modifier
    forall a. Maybe a
    Nothing,PortDirection
    Out,HWType
    hwtype,Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    dstId Maybe Modifier
    forall a. Maybe a
    Nothing)]
                  let instLabel0 = [Text] -> Text
    StrictText.concat [Identifier -> Text
    Id.toText Identifier
    compName, Text
    "_", Identifier -> Text
    Id.toText Identifier
    dstId]
                  instLabel1 <- fromMaybe instLabel0 <$> Lens.view setName
                  instLabel2 <- affixName instLabel1
                  instLabel3 <- Id.makeBasic instLabel2
                  let portMap = [(Expr, PortDirection, HWType, Expr)] -> PortMap
    NamedPortMap ([(Expr, PortDirection, HWType, Expr)]
    outpAssign [(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
    instLabel3 [] PortMap
    portMap
                  declareInstUses outpAssign
                  return (argDecls ++ argDecls' ++ tickDecls ++ [instDecl])
                else
                  let
                    argsFiltered :: [Expr]
                    argsFiltered = ((Expr, Type) -> Expr) -> [(Expr, Type)] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Expr, Type) -> Expr
    forall a b. (a, b) -> a
    fst [(Expr, Type)]
    filteredTypeExprs
                  in error [I.i|
                  Under-applied normalized function at component #{compName}:

                  #{showPpr fun}

                  Core:

                  #{showPpr bindingTerm}

                  Applied to arguments:
                  #{showPpr args}

                  Applied to filtered arguments:
                  #{argsFiltered}

                  Component inputs:
                  #{compInps}
                |]
        (Bool, Maybe TopEntityT)
    _ ->
          case [Term]
    args of
            [] -> do
              -- TODO: Figure out what to do with zero-width constructs
              assn <- HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    dstId (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    fun) Maybe Modifier
    forall a. Maybe a
    Nothing)
              pure [assn]
            [Term]
    _ -> [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [I.i|
              Netlist generation encountered a local function. This should not
              happen. Function:

                #{showPpr fun}

              Arguments:

                #{showPpr args}

              Posssible user issues:

                * A top entity has an higher-order argument, e.g (Int -> Int) or
                Maybe (Int -> Int)

              Possible internal compiler issues:

                * 'bindOrLiftNonRep' failed to fire

                * 'caseCon' failed to eliminate something of a type such as
                "Maybe (Int -> Int)"
              |]

    toSimpleVar :: DeclarationType
                -> Identifier
                -> (Expr,Type)
                -> NetlistMonad (Expr,[Declaration])
    toSimpleVar :: DeclarationType
    -> Identifier -> (Expr, Type) -> NetlistMonad (Expr, [Declaration])
    toSimpleVar DeclarationType
    _ Identifier
    _ (e :: Expr
    e@(Identifier Identifier
    _ Maybe Modifier
    Nothing),Type
    _) = (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    e,[])
    toSimpleVar DeclarationType
    declType Identifier
    dstId (Expr
    e,Type
    ty) = do
      argNm <- Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix Identifier
    dstId Text
    "fun_arg"
      hTy <- unsafeCoreTypeToHWTypeM' $(curLoc) ty
      let assignTy = DeclarationType -> Usage
    declTypeUsage DeclarationType
    declType
      argDecl <- mkInit declType assignTy argNm hTy e
      return (Identifier argNm Nothing, argDecl)

    -- | Generate an expression for a term occurring on the RHS of a let-binder
    mkExpr :: HasCallStack
           => Bool -- ^ Treat BlackBox expression as declaration
           -> DeclarationType
           -- ^ Should the returned declarations be concurrent or sequential?
           -> NetlistId -- ^ Name hint for the id to (potentially) assign the result to
           -> Term -- ^ Term to convert to an expression
           -> NetlistMonad (Expr,[Declaration]) -- ^ Returned expression and a list of generate BlackBox declarations
    mkExpr :: HasCallStack =>
    Bool
    -> DeclarationType
    -> NetlistId
    -> Term
    -> NetlistMonad (Expr, [Declaration])
    mkExpr Bool
    _ DeclarationType
    _ NetlistId
    _ (Term -> Term
    stripTicks -> Core.Literal Literal
    l) = 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 (mkLiteral iw l, [])

    mkExpr Bool
    bbEasD DeclarationType
    declType NetlistId
    bndr Term
    app =
     let (Term
    appF,[Either Term Type]
    args,[TickInfo]
    ticks) = Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks Term
    app
         ([Term]
    tmArgs,[Type]
    tyArgs) = [Either Term Type] -> ([Term], [Type])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Term Type]
    args
     in  [TickInfo]
    -> ([Declaration] -> NetlistMonad (Expr, [Declaration]))
    -> NetlistMonad (Expr, [Declaration])
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (([Declaration] -> NetlistMonad (Expr, [Declaration]))
     -> NetlistMonad (Expr, [Declaration]))
    -> ([Declaration] -> NetlistMonad (Expr, [Declaration]))
    -> NetlistMonad (Expr, [Declaration])
    forall a b. (a -> b) -> a -> b
    $ \[Declaration]
    tickDecls -> do
      hwTys  <- (Type -> NetlistMonad HWType) -> [Type] -> 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)) (NetlistId -> [Type]
    netlistTypes NetlistId
    bndr)
      (_,sp) <- Lens.use curCompNm
      let hwTyA = case [HWType]
    hwTys of
            HWType
    hwTy:[HWType]
    _ -> HWType
    hwTy
            [HWType]
    _ -> [Char] -> HWType
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error: unable to extract sufficient hwTys from: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> NetlistId -> [Char]
    forall a. Show a => a -> [Char]
    show NetlistId
    bndr)
      case appF of
        Data DataCon
    dc -> HasCallStack =>
    DeclarationType
    -> [HWType]
    -> NetlistId
    -> DataCon
    -> [Term]
    -> NetlistMonad (Expr, [Declaration])
    DeclarationType
    -> [HWType]
    -> NetlistId
    -> DataCon
    -> [Term]
    -> NetlistMonad (Expr, [Declaration])
    mkDcApplication DeclarationType
    declType [HWType]
    hwTys NetlistId
    bndr DataCon
    dc [Term]
    tmArgs
        Prim PrimInfo
    pInfo -> Bool
    -> Bool
    -> DeclarationType
    -> NetlistId
    -> PrimInfo
    -> [Either Term Type]
    -> [Declaration]
    -> NetlistMonad (Expr, [Declaration])
    mkPrimitive Bool
    False Bool
    bbEasD DeclarationType
    declType NetlistId
    bndr PrimInfo
    pInfo [Either Term Type]
    args [Declaration]
    tickDecls
        Var Id
    f
          | [Term] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [Term]
    tmArgs ->
              if HWType -> Bool
    isVoid HWType
    hwTyA then
                (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    Noop, [])
              else do
                (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 => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    f) Maybe Modifier
    forall a. Maybe a
    Nothing, [])
          | Bool -> Bool
    not ([Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [Type]
    tyArgs) ->
              ClashException -> NetlistMonad (Expr, [Declaration])
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: "
                [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Var-application with Type arguments:\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    app) Maybe [Char]
    forall a. Maybe a
    Nothing)
          | Bool
    otherwise -> do
              argNm <- Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix ((Identifier -> Identifier)
    -> (Id -> Identifier) -> NetlistId -> Identifier
    forall r.
    HasCallStack =>
    (Identifier -> r) -> (Id -> r) -> NetlistId -> r
    netlistId1 Identifier -> Identifier
    forall a. a -> a
    id HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId NetlistId
    bndr) Text
    "fun_arg"
              decls  <- mkFunApp declType argNm f tmArgs tickDecls
              if isVoid hwTyA then
                return (Noop, decls)
              else
                -- This net was already declared in the call to mkSelection.
                return ( Identifier argNm Nothing
                       , NetDecl Nothing argNm hwTyA : decls)
        Case Term
    scrut Type
    ty' [(Pat, Term)
    alt] -> DeclarationType
    -> Bool
    -> NetlistId
    -> Term
    -> Type
    -> (Pat, Term)
    -> NetlistMonad (Expr, [Declaration])
    mkProjection DeclarationType
    declType Bool
    bbEasD NetlistId
    bndr Term
    scrut Type
    ty' (Pat, Term)
    alt
        Case Term
    scrut Type
    tyA ((Pat, Term)
    alt:[(Pat, Term)]
    alts) -> do
          argNm <- Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix ((Identifier -> Identifier)
    -> (Id -> Identifier) -> NetlistId -> Identifier
    forall r.
    HasCallStack =>
    (Identifier -> r) -> (Id -> r) -> NetlistId -> r
    netlistId1 Identifier -> Identifier
    forall a. a -> a
    id HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId NetlistId
    bndr) Text
    "sel_arg"
          decls  <- mkSelection declType (NetlistId argNm (netlistTypes1 bndr))
                                scrut tyA (alt :| alts) tickDecls
          if isVoid hwTyA then
            return (Noop, decls)
          else
            -- This net was already declared in the call to mkSelection
            return ( Identifier argNm Nothing
                   , NetDecl' Nothing argNm hwTyA Nothing:decls)
        Letrec [LetBinding]
    binders Term
    body -> do
          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]
    binders
          decls    <- concatMapM (uncurry (mkDeclarations' declType)) binders
          (bodyE,bodyDecls) <- mkExpr bbEasD declType bndr (mkApps (mkTicks body ticks) args)
          return (bodyE,netDecls ++ decls ++ bodyDecls)
        Term
    _ -> ClashException -> NetlistMonad (Expr, [Declaration])
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: application of a Lambda-expression\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    app) Maybe [Char]
    forall a. Maybe a
    Nothing)

    -- | Generate an expression that projects a field out of a data-constructor.
    --
    -- Works for both product types, as sum-of-product types.
    mkProjection
      :: DeclarationType
      -> Bool
      -- ^ Projection must bind to a simple variable
      -> NetlistId
      -- ^ Name hint for the signal to which the projection is (potentially) assigned
      -> Term
      -- ^ The subject/scrutinee of the projection
      -> Type
      -- ^ The type of the result
      -> Alt
      -- ^ The field to be projected
      -> NetlistMonad (Expr, [Declaration])
    mkProjection :: DeclarationType
    -> Bool
    -> NetlistId
    -> Term
    -> Type
    -> (Pat, Term)
    -> NetlistMonad (Expr, [Declaration])
    mkProjection DeclarationType
    declType Bool
    mkDec NetlistId
    bndr Term
    scrut Type
    altTy alt :: (Pat, Term)
    alt@(Pat
    pat,Term
    v) = 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 assignTy = DeclarationType -> Usage
    declTypeUsage DeclarationType
    declType
      let scrutTy = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    scrut
          e = Term -> Type -> [(Pat, Term)] -> Term
    Case Term
    scrut Type
    scrutTy [(Pat, Term)
    alt]
      (_,sp) <- Lens.use curCompNm
      varTm <- case v of
        (Var Id
    n) -> Id -> NetlistMonad Id
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Id
    n
        Term
    _ -> ClashException -> NetlistMonad Id
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                    [Char]
    "Not in normal form: RHS of case-projection is not a variable:\n\n"
                     [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e) Maybe [Char]
    forall a. Maybe a
    Nothing)
      sHwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy
      vHwTy <- unsafeCoreTypeToHWTypeM' $(curLoc) altTy
      scrutRendered <- do
        scrutNm <-
          netlistId1
            Id.next
            (\Id
    b -> Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    b) Text
    "projection")
            bndr
        (scrutExpr,newDecls) <- mkExpr False declType (NetlistId scrutNm scrutTy) scrut
        case scrutExpr of
          Identifier Identifier
    newId Maybe Modifier
    modM ->
            Either [Declaration] (Identifier, Maybe Modifier, [Declaration])
    -> NetlistMonad
         (Either [Declaration] (Identifier, Maybe Modifier, [Declaration]))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((Identifier, Maybe Modifier, [Declaration])
    -> Either [Declaration] (Identifier, Maybe Modifier, [Declaration])
    forall a b. b -> Either a b
    Right (Identifier
    newId, Maybe Modifier
    modM, [Declaration]
    newDecls))
          Expr
    Noop ->
            -- Scrutinee was a zero-width / void construct. We need to render its
            -- declarations, but it's no use assigning it to a new variable.
            -- TODO: Figure out whether we need to render alternatives too.
            -- TODO: seems useless?
            Either [Declaration] (Identifier, Maybe Modifier, [Declaration])
    -> NetlistMonad
         (Either [Declaration] (Identifier, Maybe Modifier, [Declaration]))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Declaration]
    -> Either [Declaration] (Identifier, Maybe Modifier, [Declaration])
    forall a b. a -> Either a b
    Left [Declaration]
    newDecls)
          Expr
    _ -> do
            scrutDecl <- HasCallStack =>
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    mkInit DeclarationType
    declType Usage
    assignTy Identifier
    scrutNm HWType
    sHwTy Expr
    scrutExpr
            pure (Right (scrutNm, Nothing, newDecls ++ scrutDecl))

      case scrutRendered of
        Left [Declaration]
    newDecls -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Expr
    Noop, [Declaration]
    newDecls)
        Right (Identifier
    selId, Maybe Modifier
    modM, [Declaration]
    decls) -> do
          let altVarId :: Identifier
    altVarId = HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    varTm
          modifier <- case Pat
    pat of
            DataPat DataCon
    dc [TyVar]
    exts [Id]
    tms -> do
              let
                tms' :: [Id]
    tms' =
                  if [TyVar] -> [Id] -> Bool
    forall a. [TyVar] -> [Var a] -> Bool
    bindsExistentials [TyVar]
    exts [Id]
    tms then
                    ClashException -> [Id]
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($(curLoc)
                      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: Pattern binds existential variables:\n\n"
                      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e) Maybe [Char]
    forall a. Maybe a
    Nothing)
                  else
                    [Id]
    tms
              argHWTys <- (Type -> NetlistMonad (Maybe HWType))
    -> [Type] -> NetlistMonad [Maybe 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 Type -> NetlistMonad (Maybe HWType)
    coreTypeToHWTypeM' ((Id -> Type) -> [Id] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf [Id]
    tms)
              let tmsBundled   = [Maybe HWType] -> [Id] -> [(Maybe HWType, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Maybe HWType]
    argHWTys [Id]
    tms'
                  tmsFiltered  = ((Maybe HWType, Id) -> Bool)
    -> [(Maybe HWType, Id)] -> [(Maybe HWType, Id)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> (HWType -> Bool) -> Maybe HWType -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> Bool
    not (Bool -> Bool) -> (HWType -> Bool) -> HWType -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HWType -> Bool
    isVoid) (Maybe HWType -> Bool)
    -> ((Maybe HWType, Id) -> Maybe HWType)
    -> (Maybe HWType, Id)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe HWType, Id) -> Maybe HWType
    forall a b. (a, b) -> a
    fst) [(Maybe HWType, Id)]
    tmsBundled
                  tmsFiltered' = ((Maybe HWType, Id) -> Id) -> [(Maybe HWType, Id)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe HWType, Id) -> Id
    forall a b. (a, b) -> b
    snd [(Maybe HWType, Id)]
    tmsFiltered
              case elemIndex varTm {varType = altTy} tmsFiltered' of
                Maybe Int
    Nothing -> Maybe Modifier -> NetlistMonad (Maybe Modifier)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe Modifier
    forall a. Maybe a
    Nothing
                Just Int
    fI
                  | HWType
    sHwTy HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HWType
    vHwTy ->
                    Maybe Modifier -> NetlistMonad (Maybe Modifier)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Maybe Modifier -> NetlistMonad (Maybe Modifier))
    -> Maybe Modifier -> NetlistMonad (Maybe Modifier)
    forall a b. (a -> b) -> a -> b
    $ Maybe Modifier -> Maybe Modifier -> Maybe Modifier
    nestModifier Maybe Modifier
    modM (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (HWType
    sHwTy,DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1,Int
    fI)))
                  -- When element and subject have the same HW-type,
                  -- then the projections is just the identity
                  | Bool
    otherwise ->
                    Maybe Modifier -> NetlistMonad (Maybe Modifier)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Maybe Modifier -> NetlistMonad (Maybe Modifier))
    -> Maybe Modifier -> NetlistMonad (Maybe Modifier)
    forall a b. (a -> b) -> a -> b
    $ Maybe Modifier -> Maybe Modifier -> Maybe Modifier
    nestModifier Maybe Modifier
    modM (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int) -> Modifier
    DC (Maybe HWType -> HWType
    Void Maybe HWType
    forall a. Maybe a
    Nothing,Int
    0)))
            Pat
    _ -> ClashException -> NetlistMonad (Maybe Modifier)
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ($(curLoc)
                   [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: Unexpected pattern in case-projection:\n\n"
                   [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    e) Maybe [Char]
    forall a. Maybe a
    Nothing)
          let extractExpr = Identifier -> Maybe Modifier -> Expr
    Identifier (Identifier
    -> (Modifier -> Identifier) -> Maybe Modifier -> Identifier
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Identifier
    altVarId (Identifier -> Modifier -> Identifier
    forall a b. a -> b -> a
    const Identifier
    selId) Maybe Modifier
    modifier) Maybe Modifier
    modifier
          case bndr of
            NetlistId Identifier
    scrutNm Type
    _ | Bool
    mkDec -> do
              scrutNm' <- Identifier -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    scrutNm
              scrutDecl <- mkInit declType assignTy scrutNm' vHwTy extractExpr
              return (Identifier scrutNm' Nothing, scrutDecl ++ decls)
            MultiId {} -> [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "mkProjection: MultiId"
            NetlistId
    _ -> (Expr, [Declaration]) -> NetlistMonad (Expr, [Declaration])
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Expr
    extractExpr,[Declaration]
    decls)
      where
        nestModifier :: Maybe Modifier -> Maybe Modifier -> Maybe Modifier
    nestModifier Maybe Modifier
    Nothing  Maybe Modifier
    m          = Maybe Modifier
    m
        nestModifier Maybe Modifier
    m Maybe Modifier
    Nothing           = Maybe Modifier
    m
        nestModifier (Just Modifier
    m1) (Just Modifier
    m2) = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> Modifier -> Modifier
    Nested Modifier
    m1 Modifier
    m2)

    -- | Generate an expression for a DataCon application occurring on the RHS of a let-binder
    mkDcApplication
        :: HasCallStack
        => DeclarationType
        -> [HWType]
        -- ^ HWType of the LHS of the let-binder, can multiple types when we're
        -- creating a "split" product type (e.g. a tuple of a Clock and Reset)
        -> NetlistId
        -- ^ Name hint for result id
        -> DataCon
        -- ^ Applied DataCon
        -> [Term]
        -- ^ DataCon Arguments
        -> NetlistMonad (Expr,[Declaration])
        -- ^ Returned expression and a list of generate BlackBox declarations
    mkDcApplication :: HasCallStack =>
    DeclarationType
    -> [HWType]
    -> NetlistId
    -> DataCon
    -> [Term]
    -> NetlistMonad (Expr, [Declaration])
    mkDcApplication DeclarationType
    declType [HWType
    dstHType] NetlistId
    bndr DataCon
    dc [Term]
    args = do
      let dcNm :: Text
    dcNm = Name DataCon -> Text
    forall a. Name a -> Text
    nameOcc (DataCon -> Name DataCon
    dcName DataCon
    dc)
      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 argTys = (Term -> Type) -> [Term] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm) [Term]
    args
      argNm <- netlistId1 return (\Id
    b -> Identifier -> Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> Text -> m Identifier
    Id.suffix (HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId Id
    b) Text
    "dc_arg") bndr
      argHWTys <- mapM coreTypeToHWTypeM' argTys

      (argExprs, concat -> argDecls) <- unzip <$>
        mapM (\(Term
    e,Type
    t) -> 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
    argNm Type
    t) Term
    e) (zip args argTys)

      -- Filter void arguments, but make sure to render their declarations:
      let
        filteredTypeExprDecls =
          ((Maybe HWType, Expr) -> Bool)
    -> [(Maybe HWType, Expr)] -> [(Maybe HWType, Expr)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
            (Bool -> Bool
    not (Bool -> Bool)
    -> ((Maybe HWType, Expr) -> Bool) -> (Maybe HWType, Expr) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Maybe HWType -> Bool
    isVoidMaybe Bool
    True (Maybe HWType -> Bool)
    -> ((Maybe HWType, Expr) -> Maybe HWType)
    -> (Maybe HWType, Expr)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe HWType, Expr) -> Maybe HWType
    forall a b. (a, b) -> a
    fst)
            ([Maybe HWType] -> [Expr] -> [(Maybe HWType, Expr)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Maybe HWType]
    argHWTys [Expr]
    argExprs)

        (hWTysFiltered, argExprsFiltered) = unzip filteredTypeExprDecls

      fmap (,argDecls) $! case (hWTysFiltered,argExprsFiltered) of
        -- Is the DC just a newtype wrapper?
        ([Just HWType
    argHwTy],[Expr
    argExpr]) | HWType
    argHwTy HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HWType
    dstHType ->
          Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (Maybe HWType -> HWType
    Void Maybe HWType
    forall a. Maybe a
    Nothing,-Int
    1)) [Expr
    argExpr])
        ([Maybe HWType], [Expr])
    _ -> case HWType
    dstHType of
          SP Text
    _ [(Text, [HWType])]
    dcArgPairs -> do
            let dcI :: Int
    dcI      = DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                dcArgs :: [HWType]
    dcArgs   = (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [(Text, [HWType])] -> Int -> (Text, [HWType])
    forall a. HasCallStack => [Char] -> [a] -> Int -> a
    indexNote ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "No DC with tag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    dcI) [(Text, [HWType])]
    dcArgPairs Int
    dcI
            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([HWType] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [HWType]
    dcArgs) ([Expr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Expr]
    argExprsFiltered) of
              Ordering
    EQ -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType,Int
    dcI)) [Expr]
    argExprsFiltered)
              Ordering
    LT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Over-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
              Ordering
    GT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Under-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
          Product Text
    _ Maybe [Text]
    _ [HWType]
    dcArgs ->
            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([HWType] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [HWType]
    dcArgs) ([Expr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Expr]
    argExprsFiltered) of
              Ordering
    EQ -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType,Int
    0)) [Expr]
    argExprsFiltered)
              Ordering
    LT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Over-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
              Ordering
    GT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Under-applied constructor:" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
                                    , [Char]
    "dcArgs=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines [[Char]
    " - " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ HWType -> [Char]
    forall a. Show a => a -> [Char]
    show HWType
    x | HWType
    x <- [HWType]
    dcArgs]
                                    , [Char]
    "argExprs=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines [[Char]
    " - " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Expr -> [Char]
    forall a. Show a => a -> [Char]
    show Expr
    x | Expr
    x <- [Expr]
    argExprs]
                                    , [Char]
    "hWTysFilt=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines [[Char]
    " - " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Maybe HWType -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe HWType
    x | Maybe HWType
    x <- [Maybe HWType]
    hWTysFiltered]
                                    , [Char]
    "argExprsFilt=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines [[Char]
    " - " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Expr -> [Char]
    forall a. Show a => a -> [Char]
    show Expr
    x | Expr
    x <- [Expr]
    argExprsFiltered]
                                    ]
          CustomProduct Text
    _ DataRepr'
    _ Int
    _ Maybe [Text]
    _ [(Integer, HWType)]
    dcArgs ->
            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([(Integer, HWType)] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [(Integer, HWType)]
    dcArgs) ([Expr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Expr]
    argExprsFiltered) of
              Ordering
    EQ -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType,Int
    0)) [Expr]
    argExprsFiltered)
              Ordering
    LT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Over-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
              Ordering
    GT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Under-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
          Sum Text
    _ [Text]
    _ ->
            Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType,DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) [])
          CustomSP Text
    _ DataRepr'
    _ Int
    _ [(ConstrRepr', Text, [HWType])]
    dcArgsTups -> do
            -- Safely get item from list, or err with note
            let dcI :: Int
    dcI    = DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            let note :: [Char]
    note   = $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "No DC with tag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    dcI
            let argTup :: (ConstrRepr', Text, [HWType])
    argTup = [Char]
    -> [(ConstrRepr', Text, [HWType])]
    -> Int
    -> (ConstrRepr', Text, [HWType])
    forall a. HasCallStack => [Char] -> [a] -> Int -> a
    indexNote [Char]
    note [(ConstrRepr', Text, [HWType])]
    dcArgsTups Int
    dcI
            let (ConstrRepr'
    _, Text
    _, [HWType]
    dcArgs) = (ConstrRepr', Text, [HWType])
    argTup

            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([HWType] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [HWType]
    dcArgs) ([Expr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Expr]
    argExprsFiltered) of
              Ordering
    EQ -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType, Int
    dcI)) [Expr]
    argExprsFiltered)
              Ordering
    LT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Over-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm
              Ordering
    GT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Under-applied constructor: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    StrictText.unpack Text
    dcNm

          CustomSum Text
    _ DataRepr'
    _ Int
    _ [(ConstrRepr', Text)]
    _ ->
            Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType, DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) [])
          Enable Text
    _ ->
            case [Expr]
    argExprsFiltered of
              [Expr
    x] -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType,DataCon -> Int
    dcTag DataCon
    dc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) [Expr
    x])
              [Expr]
    _   -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "unexpected arguments to Enable: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Expr] -> [Char]
    forall a. Show a => a -> [Char]
    show [Expr]
    argExprsFiltered
          HWType
    Bool ->
            let dc' :: Expr
    dc' = case DataCon -> Int
    dcTag DataCon
    dc of
                       Int
    1  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bool -> Literal
    BoolLit Bool
    False)
                       Int
    2  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bool -> Literal
    BoolLit Bool
    True)
                       Int
    tg -> [Char] -> Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Expr) -> [Char] -> Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "unknown bool literal: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ DataCon -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr DataCon
    dc [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "(tag: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    tg [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
            in  Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Expr
    dc'
          Vector Int
    0 HWType
    _ -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType Modifier
    VecAppend [])
          Vector Int
    1 HWType
    _ -> case [Expr]
    argExprsFiltered of
                          [Expr
    e] -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType Modifier
    VecAppend [Expr
    e])
                          [Expr]
    _ -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Unexpected number of arguments for `Cons`: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    args
          Vector Int
    _ HWType
    _ -> case [Expr]
    argExprsFiltered of
                          [Expr
    e1,Expr
    e2] -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType Modifier
    VecAppend [Expr
    e1,Expr
    e2])
                          [Expr]
    _ -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Unexpected number of arguments for `Cons`: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    args
          MemBlob Int
    _ Int
    _ ->
            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    6 ([Expr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Expr]
    argExprsFiltered) of
              Ordering
    EQ -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType ((HWType, Int) -> Modifier
    DC (HWType
    dstHType,Int
    0)) [Expr]
    argExprsFiltered)
              Ordering
    LT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Over-applied constructor"
              Ordering
    GT -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Under-applied constructor"
          RTree Int
    0 HWType
    _ -> case [Expr]
    argExprsFiltered of
                          [Expr
    e] -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType Modifier
    RTreeAppend [Expr
    e])
                          [Expr]
    _ -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Unexpected number of arguments for `LR`: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    args
          RTree Int
    _ HWType
    _ -> case [Expr]
    argExprsFiltered of
                          [Expr
    e1,Expr
    e2] -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> Modifier -> [Expr] -> Expr
    HW.DataCon HWType
    dstHType Modifier
    RTreeAppend [Expr
    e1,Expr
    e2])
                          [Expr]
    _ -> [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Unexpected number of arguments for `BR`: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Term] -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr [Term]
    args
          HWType
    String ->
            let dc' :: Expr
    dc' = case DataCon -> Int
    dcTag DataCon
    dc of
                        Int
    1 -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing ([Char] -> Literal
    StringLit [Char]
    "")
                        Int
    _ -> [Char] -> Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Expr) -> [Char] -> Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "mkDcApplication undefined for: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (HWType, DataCon, Int, [Term], [Maybe HWType]) -> [Char]
    forall a. Show a => a -> [Char]
    show (HWType
    dstHType,DataCon
    dc,DataCon -> Int
    dcTag DataCon
    dc,[Term]
    args,[Maybe HWType]
    argHWTys)
            in  Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Expr
    dc'
          Void {} -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Expr
    Noop
          Signed Int
    _
    #if MIN_VERSION_base(4,15,0)
            | Text
    dcNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.IS"
    #else
            | dcNm == "GHC.Integer.Type.S#"
    #endif
            , (Expr
    a:[Expr]
    _) <- [Expr]
    argExprsFiltered
            -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Expr
    a
            -- ByteArray# are non-translatable / void, except when they're literals
    #if MIN_VERSION_base(4,15,0)
            | Text
    dcNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.IP"
    #else
            | dcNm == "GHC.Integer.Type.Jp#"
    #endif
            , (a :: Expr
    a@(HW.Literal Maybe (HWType, Int)
    Nothing (NumLit Integer
    _)):[Expr]
    _) <- [Expr]
    argExprs
            -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Expr
    a
    #if MIN_VERSION_base(4,15,0)
            | Text
    dcNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Integer.IN"
    #else
            | dcNm == "GHC.Integer.Type.Jn#"
    #endif
            -- ByteArray# are non-translatable / void, except when they're literals
            , (HW.Literal Maybe (HWType, Int)
    Nothing (NumLit Integer
    i):[Expr]
    _) <- [Expr]
    argExprs
            -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Integer -> Literal
    NumLit (Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    i)))
          Unsigned Int
    _
    #if MIN_VERSION_base(4,15,0)
            | Text
    dcNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Natural.NS"
    #else
            | dcNm == "GHC.Natural.NatS#"
    #endif
            , (Expr
    a:[Expr]
    _) <- [Expr]
    argExprsFiltered
            -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Expr
    a
    #if MIN_VERSION_base(4,15,0)
            | Text
    dcNm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "GHC.Num.Natural.NB"
    #else
            | dcNm == "GHC.Natural.NatJ#"
    #endif
            -- ByteArray# are non-translatable / void, except when they're literals
            , (a :: Expr
    a@(HW.Literal Maybe (HWType, Int)
    Nothing (NumLit Integer
    _)):[Expr]
    _) <- [Expr]
    argExprs
            -> Expr -> NetlistMonad Expr
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Expr
    a
          HWType
    _ ->
            [Char] -> NetlistMonad Expr
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Expr) -> [Char] -> NetlistMonad Expr
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "mkDcApplication undefined for: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (HWType, DataCon, [Term], [Maybe HWType]) -> [Char]
    forall a. Show a => a -> [Char]
    show (HWType
    dstHType,DataCon
    dc,[Term]
    args,[Maybe HWType]
    argHWTys)

    -- Handle MultiId assignment
    mkDcApplication DeclarationType
    declType [HWType]
    dstHTypes (MultiId [Id]
    argNms) DataCon
    _ [Term]
    args = 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 argTys          = (Term -> Type) -> [Term] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm) [Term]
    args
      argHWTys            <- mapM coreTypeToHWTypeM' argTys
      -- Filter out the arguments of hwtype `Void` and only translate
      -- them to the intermediate HDL afterwards
      let argsBundled   = [Maybe HWType]
    -> [(NetlistId, Term)] -> [(Maybe HWType, (NetlistId, Term))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Maybe HWType]
    argHWTys ([NetlistId] -> [Term] -> [(NetlistId, Term)]
    forall a b. [a] -> [b] -> [(a, b)]
    zipEqual ((Id -> NetlistId) -> [Id] -> [NetlistId]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> NetlistId
    CoreId [Id]
    argNms) [Term]
    args)
          (_hWTysFiltered,argsFiltered) = unzip
            (filter (maybe True (not . isVoid) . fst) argsBundled)
      (argExprs,argDecls) <- fmap (second concat . unzip) $!
                             mapM (uncurry (mkExpr False declType)) argsFiltered
      if length dstHTypes == length argExprs then do
        assns <- mapMaybeM
                      (\case (NetlistId
    _,Expr
    Noop) -> Maybe Declaration -> NetlistMonad (Maybe Declaration)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe Declaration
    forall a. Maybe a
    Nothing
                             (NetlistId
    dstId,Expr
    e) -> let nm :: Identifier
    nm = (Identifier -> Identifier)
    -> (Id -> Identifier) -> NetlistId -> Identifier
    forall r.
    HasCallStack =>
    (Identifier -> r) -> (Id -> r) -> NetlistId -> r
    netlistId1 Identifier -> Identifier
    forall a. a -> a
    id HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId NetlistId
    dstId
                                           in case Expr
    e of
                                                Identifier Identifier
    nm0 Maybe Modifier
    Nothing
                                                  | Identifier
    nm Identifier -> Identifier -> Bool
    forall a. Eq a => a -> a -> Bool
    == Identifier
    nm0 -> Maybe Declaration -> NetlistMonad (Maybe Declaration)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe Declaration
    forall a. Maybe a
    Nothing
                                                Expr
    _ -> Declaration -> Maybe Declaration
    forall a. a -> Maybe a
    Just (Declaration -> Maybe Declaration)
    -> NetlistMonad Declaration -> NetlistMonad (Maybe Declaration)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> case DeclarationType
    declType of
                                                                DeclarationType
    Concurrent -> HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    nm Expr
    e
                                                                DeclarationType
    Sequential -> HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    Blocking Identifier
    nm Expr
    e)
                      (zipEqual (map CoreId argNms) argExprs)
        return (Noop,argDecls ++ assns)
      else
        error "internal error"

    mkDcApplication DeclarationType
    _ [HWType]
    _ NetlistId
    _ DataCon
    _ [Term]
    _ = [Char] -> NetlistMonad (Expr, [Declaration])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error"