    {-|
      Copyright  :  (C) 2012-2016, University of Twente,
                        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>

      Utilities for converting Core Type/Term to Netlist datatypes
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MagicHash #-}
    #if !MIN_VERSION_ghc(8,8,0)
    {-# LANGUAGE MonadFailDesugaring #-}
    #endif
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Clash.Netlist.Util where

    import           Data.Coerce             (coerce)
    import           Control.Exception       (throw)
    import           Control.Lens            ((.=), (%=))
    import qualified Control.Lens            as Lens
    import           Control.Monad           (when, zipWithM)
    import           Control.Monad.Extra     (concatMapM)
    import           Control.Monad.Reader    (ask, local)
    import qualified Control.Monad.State as State
    import           Control.Monad.State.Strict
      (State, evalState, get, modify, runState)
    import           Control.Monad.Trans.Except
      (ExceptT (..), runExcept, runExceptT, throwE)
    import           Data.Bifunctor          (second)
    import           Data.Char               (ord)
    import           Data.Either             (partitionEithers)
    import           Data.Foldable           (Foldable(toList))
    import           Data.Functor            (($>))
    import           Data.Hashable           (Hashable)
    import           Data.HashMap.Strict     (HashMap)
    import qualified Data.HashMap.Strict     as HashMap
    import           Data.Primitive.ByteArray (ByteArray (..))
    import           Control.Applicative     (Alternative((<|>)))
    import           Data.List               (unzip4, partition)
    import qualified Data.List               as List
    import qualified Data.Map                as Map
    import           Data.Map                (Map)
    import           Data.Maybe
      (catMaybes, fromMaybe, isNothing, mapMaybe, isJust, listToMaybe, maybeToList)
    import           Text.Printf             (printf)
    import           Data.Text               (Text)
    import qualified Data.Text               as Text
    import           Data.Text.Extra         (showt)
    import           Data.Text.Lazy          (toStrict)
    import           Data.Text.Prettyprint.Doc.Extra

    #if MIN_VERSION_base(4,15,0)
    import           GHC.Num.Integer                  (Integer (..))
    #else
    import           GHC.Integer.GMP.Internals        (Integer (..), BigNat (..))
    #endif

    import           GHC.Stack               (HasCallStack)

    #if MIN_VERSION_ghc(9,0,0)
    import           GHC.Utils.Monad         (zipWith3M)
    import           GHC.Utils.Outputable    (ppr, showSDocUnsafe)
    #else
    import           MonadUtils              (zipWith3M)
    import           Outputable              (ppr, showSDocUnsafe)
    #endif

    import           Clash.Annotations.TopEntity
      (TopEntity(..), PortName(..), defSyn)
    import           Clash.Annotations.BitRepresentation.ClashLib
      (coreToType')
    import           Clash.Annotations.BitRepresentation.Internal
      (CustomReprs, ConstrRepr'(..), DataRepr'(..), getDataRepr,
       uncheckedGetConstrRepr)
    import           Clash.Annotations.SynthesisAttributes (Attr)
    import           Clash.Annotations.Primitive (HDL(VHDL))
    import           Clash.Backend           (HasUsageMap (..), HWKind(..), hdlHWTypeKind, hdlKind)
    import           Clash.Core.DataCon      (DataCon (..))
    import           Clash.Core.EqSolver     (typeEq)
    import           Clash.Core.FreeVars     (typeFreeVars, typeFreeVars')
    import           Clash.Core.HasFreeVars  (elemFreeVars)
    import           Clash.Core.HasType
    import qualified Clash.Core.Literal      as C
    import           Clash.Core.Name
      (Name (..), appendToName, nameOcc)
    import           Clash.Core.Pretty       (showPpr)
    import           Clash.Core.Subst
      (Subst (..), extendIdSubst, extendIdSubstList, extendInScopeId,
       extendInScopeIdList, mkSubst, substTm)
    import           Clash.Core.Term
      (primMultiResult, MultiPrimInfo(..), Alt, LetBinding, Pat (..), Term (..), TickInfo (..), NameMod (..),
       IsMultiPrim (..), collectArgsTicks, collectTicks, collectBndrs, PrimInfo(primName), mkTicks, stripTicks)
    import           Clash.Core.TermInfo
    import           Clash.Core.TyCon
      (TyCon (FunTyCon), TyConName, TyConMap, tyConDataCons)
    import           Clash.Core.Type
      (Type (..), TyVar, TypeView (..), coreView1, normalizeType, splitTyConAppM, tyView)
    import           Clash.Core.Util
      (substArgTys, tyLitShow)
    import           Clash.Core.Var
      (Id, Var (..), mkLocalId, modifyVarName)
    import           Clash.Core.VarEnv
      (InScopeSet, extendInScopeSetList, uniqAway, lookupVarEnv)
    import qualified Clash.Data.UniqMap as UniqMap
    import {-# SOURCE #-} Clash.Netlist.BlackBox
    import {-# SOURCE #-} Clash.Netlist.BlackBox.Util
    import           Clash.Netlist.BlackBox.Types
      (bbResultNames, BlackBoxMeta(BlackBoxMeta))
    import qualified Clash.Netlist.Id as Id
    import           Clash.Netlist.Types     as HW
    import           Clash.Primitives.Types
    import           Clash.Util
    import qualified Clash.Util.Interpolate  as I

    hmFindWithDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    #if MIN_VERSION_unordered_containers(0,2,11)
    hmFindWithDefault :: forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    hmFindWithDefault = v -> k -> HashMap k v -> v
    forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    HashMap.findWithDefault
    #else
    hmFindWithDefault = HashMap.lookupDefault
    #endif

    -- | Generate a simple port_name expression. See:
    --
    --   https://www.hdlworks.com/hdl_corner/vhdl_ref/VHDLContents/PortMap.htm
    --
    -- This function will simply make the left part of a single port map, e.g. "Rst"
    -- in:
    --
    --  Rst => Reset
    --
    -- If you need more complex constructions, e.g.
    --
    --  Q(3 downto 1)
    --
    -- you can build an Expr manually.
    instPort :: Text -> Expr
    instPort :: Text -> Expr
    instPort Text
    pn = Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    pn) Maybe Modifier
    forall a. Maybe a
    Nothing

    -- | Throw away information indicating which constructor fields were filtered
    -- due to being void.
    stripFiltered :: FilteredHWType -> HWType
    stripFiltered :: FilteredHWType -> HWType
    stripFiltered (FilteredHWType HWType
    hwty [[(IsVoid, FilteredHWType)]]
    _filtered) = HWType
    hwty

    -- | Strip as many "Void" layers as possible. Might still return a Void if the
    -- void doesn't contain a hwtype.
    stripVoid :: HWType -> HWType
    stripVoid :: HWType -> HWType
    stripVoid (Void (Just HWType
    e)) = HWType -> HWType
    stripVoid HWType
    e
    stripVoid HWType
    e = HWType
    e

    flattenFiltered :: FilteredHWType -> [[Bool]]
    flattenFiltered :: FilteredHWType -> [[IsVoid]]
    flattenFiltered (FilteredHWType HWType
    _hwty [[(IsVoid, FilteredHWType)]]
    filtered) = ([(IsVoid, FilteredHWType)] -> [IsVoid])
    -> [[(IsVoid, FilteredHWType)]] -> [[IsVoid]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((IsVoid, FilteredHWType) -> IsVoid)
    -> [(IsVoid, FilteredHWType)] -> [IsVoid]
    forall a b. (a -> b) -> [a] -> [b]
    map (IsVoid, FilteredHWType) -> IsVoid
    forall a b. (a, b) -> a
    fst) [[(IsVoid, FilteredHWType)]]
    filtered

    isVoidMaybe :: Bool -> Maybe HWType -> Bool
    isVoidMaybe :: IsVoid -> Maybe HWType -> IsVoid
    isVoidMaybe IsVoid
    dflt Maybe HWType
    Nothing = IsVoid
    dflt
    isVoidMaybe IsVoid
    _dflt (Just HWType
    t) = HWType -> IsVoid
    isVoid HWType
    t

    -- | Determines if type is a zero-width construct ("void")
    isVoid :: HWType -> Bool
    isVoid :: HWType -> IsVoid
    isVoid Void {} = IsVoid
    True
    isVoid HWType
    _       = IsVoid
    False

    -- | Same as @isVoid@, but on @FilteredHWType@ instead of @HWType@
    isFilteredVoid :: FilteredHWType -> Bool
    isFilteredVoid :: FilteredHWType -> IsVoid
    isFilteredVoid = HWType -> IsVoid
    isVoid (HWType -> IsVoid)
    -> (FilteredHWType -> HWType) -> FilteredHWType -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilteredHWType -> HWType
    stripFiltered

    squashLets :: Term -> Term
    squashLets :: Term -> Term
    squashLets (Letrec [LetBinding]
    xs (Letrec [LetBinding]
    ys Term
    e)) =
      Term -> Term
    squashLets ([LetBinding] -> Term -> Term
    Letrec ([LetBinding]
    xs [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. Semigroup a => a -> a -> a
    <> [LetBinding]
    ys) Term
    e)
    squashLets Term
    e = Term
    e

    -- | Split a normalized term into: a list of arguments, a list of let-bindings,
    -- and a variable reference that is the body of the let-binding. Returns a
    -- String containing the error if the term was not in a normalized form.
    splitNormalized
      :: TyConMap
      -> Term
      -> (Either String ([Id],[LetBinding],Id))
    splitNormalized :: TyConMap -> Term -> Either [Char] ([Id], [LetBinding], Id)
    splitNormalized TyConMap
    tcm Term
    expr = case Term -> ([Either Id TyVar], Term)
    collectBndrs Term
    expr of
      ([Either Id TyVar]
    args, Term -> (Term, [TickInfo])
    collectTicks -> (Term -> Term
    squashLets -> Letrec [LetBinding]
    xes Term
    e, [TickInfo]
    ticks))
        | ([Id]
    tmArgs,[]) <- [Either Id TyVar] -> ([Id], [TyVar])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Id TyVar]
    args -> case Term -> Term
    stripTicks Term
    e of
            Var Id
    v -> ([Id], [LetBinding], Id) -> Either [Char] ([Id], [LetBinding], Id)
    forall a b. b -> Either a b
    Right ([Id]
    tmArgs, (LetBinding -> LetBinding) -> [LetBinding] -> [LetBinding]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Term -> Term) -> LetBinding -> LetBinding
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: Type -> Type -> Type) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second (Term -> [TickInfo] -> Term
    `mkTicks` [TickInfo]
    ticks)) [LetBinding]
    xes,Id
    v)
            Term
    t     -> [Char] -> Either [Char] ([Id], [LetBinding], Id)
    forall a b. a -> Either a b
    Left ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: res not simple var: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    t)
        | IsVoid
    otherwise -> [Char] -> Either [Char] ([Id], [LetBinding], Id)
    forall a b. a -> Either a b
    Left ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: tyArgs")
      ([Either Id TyVar], Term)
    _ ->
        [Char] -> Either [Char] ([Id], [LetBinding], Id)
    forall a b. a -> Either a b
    Left ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Not in normal form: no Letrec:\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Term -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Term
    expr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
              [Char]
    "\n\nWhich has type:\n\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type
    ty)
     where
      ty :: Type
    ty = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    tcm Term
    expr

    -- | Converts a Core type to a HWType given a function that translates certain
    -- builtin types. Errors if the Core type is not translatable.
    unsafeCoreTypeToHWType
      :: SrcSpan
      -- ^ Approximate location in original source file
      -> String
      -> (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -> CustomReprs
      -> TyConMap
      -> Type
      -> State HWMap FilteredHWType
    unsafeCoreTypeToHWType :: SrcSpan
    -> [Char]
    -> (CustomReprs
        -> TyConMap
        -> Type
        -> State
             (Map Type (Either [Char] FilteredHWType))
             (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> State (Map Type (Either [Char] FilteredHWType)) FilteredHWType
    unsafeCoreTypeToHWType SrcSpan
    sp [Char]
    loc CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty =
      ([Char] -> FilteredHWType)
    -> (FilteredHWType -> FilteredHWType)
    -> Either [Char] FilteredHWType
    -> FilteredHWType
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (\[Char]
    msg -> ClashException -> FilteredHWType
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    sp ([Char]
    loc [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    msg) Maybe [Char]
    forall a. Maybe a
    Nothing)) FilteredHWType -> FilteredHWType
    forall a. a -> a
    id (Either [Char] FilteredHWType -> FilteredHWType)
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    -> State (Map Type (Either [Char] FilteredHWType)) FilteredHWType
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    coreTypeToHWType CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty

    -- | Same as @unsafeCoreTypeToHWTypeM@, but discards void filter information
    unsafeCoreTypeToHWTypeM'
      :: String
      -> Type
      -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' :: [Char] -> Type -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' [Char]
    loc Type
    ty =
      FilteredHWType -> HWType
    stripFiltered (FilteredHWType -> HWType)
    -> NetlistMonad FilteredHWType -> NetlistMonad HWType
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> Type -> NetlistMonad FilteredHWType
    unsafeCoreTypeToHWTypeM [Char]
    loc Type
    ty

    -- | Converts a Core type to a HWType within the NetlistMonad; errors on failure
    unsafeCoreTypeToHWTypeM
      :: String
      -> Type
      -> NetlistMonad FilteredHWType
    unsafeCoreTypeToHWTypeM :: [Char] -> Type -> NetlistMonad FilteredHWType
    unsafeCoreTypeToHWTypeM [Char]
    loc Type
    ty = do
      (_,cmpNm) <- 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
      tt        <- Lens.use typeTranslator
      reprs     <- Lens.view customReprs
      tcm       <- Lens.view tcCache
      htm0      <- Lens.use htyCache
      let (hty,htm1) = runState (unsafeCoreTypeToHWType cmpNm loc tt reprs tcm ty) htm0
      htyCache Lens..= htm1
      return hty

    -- | Same as @coreTypeToHWTypeM@, but discards void filter information
    coreTypeToHWTypeM'
      :: Type
      -- ^ Type to convert to HWType
      -> NetlistMonad (Maybe HWType)
    coreTypeToHWTypeM' :: Type -> NetlistMonad (Maybe HWType)
    coreTypeToHWTypeM' Type
    ty =
      (FilteredHWType -> HWType) -> Maybe FilteredHWType -> Maybe HWType
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilteredHWType -> HWType
    stripFiltered (Maybe FilteredHWType -> Maybe HWType)
    -> NetlistMonad (Maybe FilteredHWType)
    -> NetlistMonad (Maybe HWType)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> NetlistMonad (Maybe FilteredHWType)
    coreTypeToHWTypeM Type
    ty

    -- | Converts a Core type to a HWType within the NetlistMonad; 'Nothing' on failure
    coreTypeToHWTypeM
      :: Type
      -- ^ Type to convert to HWType
      -> NetlistMonad (Maybe FilteredHWType)
    coreTypeToHWTypeM :: Type -> NetlistMonad (Maybe FilteredHWType)
    coreTypeToHWTypeM Type
    ty = do
      tt    <- Getting
      (CustomReprs
       -> TyConMap
       -> Type
       -> State
            (Map Type (Either [Char] FilteredHWType))
            (Maybe (Either [Char] FilteredHWType)))
      NetlistState
      (CustomReprs
       -> TyConMap
       -> Type
       -> State
            (Map Type (Either [Char] FilteredHWType))
            (Maybe (Either [Char] FilteredHWType)))
    -> NetlistMonad
         (CustomReprs
          -> TyConMap
          -> Type
          -> State
               (Map Type (Either [Char] FilteredHWType))
               (Maybe (Either [Char] FilteredHWType)))
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting
      (CustomReprs
       -> TyConMap
       -> Type
       -> State
            (Map Type (Either [Char] FilteredHWType))
            (Maybe (Either [Char] FilteredHWType)))
      NetlistState
      (CustomReprs
       -> TyConMap
       -> Type
       -> State
            (Map Type (Either [Char] FilteredHWType))
            (Maybe (Either [Char] FilteredHWType)))
    Lens'
      NetlistState
      (CustomReprs
       -> TyConMap
       -> Type
       -> State
            (Map Type (Either [Char] FilteredHWType))
            (Maybe (Either [Char] FilteredHWType)))
    typeTranslator
      reprs <- Lens.view customReprs
      tcm   <- Lens.view tcCache
      htm0  <- Lens.use htyCache
      let (hty,htm1) = runState (coreTypeToHWType tt reprs tcm ty) htm0
      htyCache Lens..= htm1
      return (either (const Nothing) Just hty)

    -- | Constructs error message for unexpected projections out of a type annotated
    -- with a custom bit representation.
    unexpectedProjectionErrorMsg
      :: DataRepr'
      -> Int
      -- ^ Constructor index
      -> Int
      -- ^ Field index
      -> String
    unexpectedProjectionErrorMsg :: DataRepr' -> Int -> Int -> [Char]
    unexpectedProjectionErrorMsg DataRepr'
    dataRepr Int
    cI Int
    fI =
         [Char]
    "Unexpected projection of zero-width type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type' -> [Char]
    forall a. Show a => a -> [Char]
    show (DataRepr' -> Type'
    drType DataRepr'
    dataRepr)
      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ". Tried to make a projection of field " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    fI [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " of "
      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    constrNm [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ". Did you try to project a field marked as zero-width"
      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " by a custom bit representation annotation?"
     where
       constrNm :: [Char]
    constrNm = Text -> [Char]
    forall a. Show a => a -> [Char]
    show (ConstrRepr' -> Text
    crName (DataRepr' -> [ConstrRepr']
    drConstrs DataRepr'
    dataRepr [ConstrRepr'] -> Int -> ConstrRepr'
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    cI))

    -- | Helper function of 'maybeConvertToCustomRepr'
    convertToCustomRepr
      :: HasCallStack
      => CustomReprs
      -> DataRepr'
      -> HWType
      -> HWType
    convertToCustomRepr :: HasCallStack => CustomReprs -> DataRepr' -> HWType -> HWType
    convertToCustomRepr CustomReprs
    reprs dRepr :: DataRepr'
    dRepr@(DataRepr' Type'
    name' Int
    size [ConstrRepr']
    constrs) HWType
    hwTy =
      if [ConstrRepr'] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [ConstrRepr']
    constrs Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    nConstrs then
        if Int
    size Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    <= Int
    0 then
          Maybe HWType -> HWType
    Void (HWType -> Maybe HWType
    forall a. a -> Maybe a
    Just HWType
    cs)
        else
          HWType
    cs
      else
        [Char] -> HWType
    forall a. HasCallStack => [Char] -> a
    error ([[Char]] -> [Char]
    unwords
          [ [Char]
    "Type", Type' -> [Char]
    forall a. Show a => a -> [Char]
    show Type'
    name', [Char]
    "has", Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    nConstrs, [Char]
    "constructor(s), "
          , [Char]
    "but the custom bit representation only specified", Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([ConstrRepr'] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [ConstrRepr']
    constrs)
          , [Char]
    "constructors."
          ])
     where
      cs :: HWType
    cs = HWType -> HWType
    insertVoids (HWType -> HWType) -> HWType -> HWType
    forall a b. (a -> b) -> a -> b
    $ case HWType
    hwTy of
        Sum Text
    name [Text]
    conIds ->
          Text -> DataRepr' -> Int -> [(ConstrRepr', Text)] -> HWType
    CustomSum Text
    name DataRepr'
    dRepr Int
    size ((Text -> (ConstrRepr', Text)) -> [Text] -> [(ConstrRepr', Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> (ConstrRepr', Text)
    packSum [Text]
    conIds)
        SP Text
    name [(Text, [HWType])]
    conIdsAndFieldTys ->
          Text
    -> DataRepr' -> Int -> [(ConstrRepr', Text, [HWType])] -> HWType
    CustomSP Text
    name DataRepr'
    dRepr Int
    size (((Text, [HWType]) -> (ConstrRepr', Text, [HWType]))
    -> [(Text, [HWType])] -> [(ConstrRepr', Text, [HWType])]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, [HWType]) -> (ConstrRepr', Text, [HWType])
    forall {c}. (Text, c) -> (ConstrRepr', Text, c)
    packSP [(Text, [HWType])]
    conIdsAndFieldTys)
        Product Text
    name Maybe [Text]
    maybeFieldNames [HWType]
    fieldTys
          | [ConstrRepr' Text
    _cName Int
    _pos Integer
    _mask Integer
    _val [Integer]
    fieldAnns] <- [ConstrRepr']
    constrs ->
          Text
    -> DataRepr'
    -> Int
    -> Maybe [Text]
    -> [(Integer, HWType)]
    -> HWType
    CustomProduct Text
    name DataRepr'
    dRepr Int
    size Maybe [Text]
    maybeFieldNames ([Integer] -> [HWType] -> [(Integer, HWType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    fieldAnns [HWType]
    fieldTys)
        HWType
    _ ->
          [Char] -> HWType
    forall a. HasCallStack => [Char] -> a
    error
            ( [Char]
    "Found a custom bit representation annotation " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ DataRepr' -> [Char]
    forall a. Show a => a -> [Char]
    show DataRepr'
    dRepr [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", "
           [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "but it was applied to an unsupported HWType: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ HWType -> [Char]
    forall a. Show a => a -> [Char]
    show HWType
    hwTy [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ".")

      nConstrs :: Int
      nConstrs :: Int
    nConstrs = case HWType
    hwTy of
        (Sum Text
    _name [Text]
    conIds) -> [Text] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Text]
    conIds
        (SP Text
    _name [(Text, [HWType])]
    conIdsAndFieldTys) -> [(Text, [HWType])] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [(Text, [HWType])]
    conIdsAndFieldTys
        (Product {}) -> Int
    1
        HWType
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Unexpected HWType: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ HWType -> [Char]
    forall a. Show a => a -> [Char]
    show HWType
    hwTy)

      packSP :: (Text, c) -> (ConstrRepr', Text, c)
    packSP (Text
    name, c
    tys) = (HasCallStack => Text -> CustomReprs -> ConstrRepr'
    Text -> CustomReprs -> ConstrRepr'
    uncheckedGetConstrRepr Text
    name CustomReprs
    reprs, Text
    name, c
    tys)
      packSum :: Text -> (ConstrRepr', Text)
    packSum Text
    name = (HasCallStack => Text -> CustomReprs -> ConstrRepr'
    Text -> CustomReprs -> ConstrRepr'
    uncheckedGetConstrRepr Text
    name CustomReprs
    reprs, Text
    name)

      -- Replace some "hwTy" with "Void (Just hwTy)" if the custom bit
      -- representation indicated that field is represented by zero bits. We can't
      -- simply remove them, as we'll later have to deal with an "overapplied"
      -- constructor. If we remove the arguments altogether, we wouldn't know which
      -- - on their own potentially non-void! - arguments to ignore.
      insertVoids :: HWType -> HWType
      insertVoids :: HWType -> HWType
    insertVoids (CustomSP Text
    i DataRepr'
    d Int
    s [(ConstrRepr', Text, [HWType])]
    constrs0) =
        Text
    -> DataRepr' -> Int -> [(ConstrRepr', Text, [HWType])] -> HWType
    CustomSP Text
    i DataRepr'
    d Int
    s (((ConstrRepr', Text, [HWType]) -> (ConstrRepr', Text, [HWType]))
    -> [(ConstrRepr', Text, [HWType])]
    -> [(ConstrRepr', Text, [HWType])]
    forall a b. (a -> b) -> [a] -> [b]
    map (ConstrRepr', Text, [HWType]) -> (ConstrRepr', Text, [HWType])
    forall {b}.
    (ConstrRepr', b, [HWType]) -> (ConstrRepr', b, [HWType])
    go0 [(ConstrRepr', Text, [HWType])]
    constrs0)
       where
        go0 :: (ConstrRepr', b, [HWType]) -> (ConstrRepr', b, [HWType])
    go0 (con :: ConstrRepr'
    con@(ConstrRepr' Text
    _ Int
    _ Integer
    _ Integer
    _ [Integer]
    fieldAnns), b
    i0, [HWType]
    hwTys) =
          (ConstrRepr'
    con, b
    i0, (Integer -> HWType -> HWType) -> [Integer] -> [HWType] -> [HWType]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Integer -> HWType -> HWType
    forall {a}. (Eq a, Num a) => a -> HWType -> HWType
    go1 [Integer]
    fieldAnns [HWType]
    hwTys)
        go1 :: a -> HWType -> HWType
    go1 a
    0 HWType
    hwTy0 = Maybe HWType -> HWType
    Void (HWType -> Maybe HWType
    forall a. a -> Maybe a
    Just HWType
    hwTy0)
        go1 a
    _ HWType
    hwTy0 = HWType
    hwTy0
      insertVoids (CustomProduct Text
    i DataRepr'
    d Int
    s Maybe [Text]
    f [(Integer, HWType)]
    fieldAnns) =
        Text
    -> DataRepr'
    -> Int
    -> Maybe [Text]
    -> [(Integer, HWType)]
    -> HWType
    CustomProduct Text
    i DataRepr'
    d Int
    s Maybe [Text]
    f (((Integer, HWType) -> (Integer, HWType))
    -> [(Integer, HWType)] -> [(Integer, HWType)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Integer, HWType) -> (Integer, HWType)
    forall {a}. (Eq a, Num a) => (a, HWType) -> (a, HWType)
    go [(Integer, HWType)]
    fieldAnns)
       where
        go :: (a, HWType) -> (a, HWType)
    go (a
    0, HWType
    hwTy0) = (a
    0, Maybe HWType -> HWType
    Void (HWType -> Maybe HWType
    forall a. a -> Maybe a
    Just HWType
    hwTy0))
        go (a
    n, HWType
    hwTy0) = (a
    n, HWType
    hwTy0)
      insertVoids HWType
    hwTy0 = HWType
    hwTy0

    -- | Given a map containing custom bit representation, a type, and the same
    -- type represented as HWType, convert the HWType to a CustomSP/CustomSum if
    -- it has a custom bit representation.
    maybeConvertToCustomRepr
      :: CustomReprs
      -- ^ Map containing all custom representations index on its type
      -> Type
      -- ^ Custom reprs are index on type, so we need the clash core type to look
      -- it up.
      -> FilteredHWType
      -- ^ Type of previous argument represented as a HWType
      -> FilteredHWType
    maybeConvertToCustomRepr :: CustomReprs -> Type -> FilteredHWType -> FilteredHWType
    maybeConvertToCustomRepr CustomReprs
    reprs (Type -> Either [Char] Type'
    coreToType' -> Right Type'
    tyName) (FilteredHWType HWType
    hwTy [[(IsVoid, FilteredHWType)]]
    filtered)
      | Just DataRepr'
    dRepr <- Type' -> CustomReprs -> Maybe DataRepr'
    getDataRepr Type'
    tyName CustomReprs
    reprs =
        HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType
          (HasCallStack => CustomReprs -> DataRepr' -> HWType -> HWType
    CustomReprs -> DataRepr' -> HWType -> HWType
    convertToCustomRepr CustomReprs
    reprs DataRepr'
    dRepr HWType
    hwTy)
          [ [ (Integer
    fieldAnn Integer -> Integer -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Integer
    0, FilteredHWType
    hwty) | ((IsVoid
    _, FilteredHWType
    hwty), Integer
    fieldAnn) <- [(IsVoid, FilteredHWType)]
    -> [Integer] -> [((IsVoid, FilteredHWType), Integer)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(IsVoid, FilteredHWType)]
    fields (ConstrRepr' -> [Integer]
    crFieldAnns ConstrRepr'
    constr) ]
                                    | ([(IsVoid, FilteredHWType)]
    fields, ConstrRepr'
    constr) <- [[(IsVoid, FilteredHWType)]]
    -> [ConstrRepr'] -> [([(IsVoid, FilteredHWType)], ConstrRepr')]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [[(IsVoid, FilteredHWType)]]
    filtered (DataRepr' -> [ConstrRepr']
    drConstrs DataRepr'
    dRepr)]
    maybeConvertToCustomRepr CustomReprs
    _reprs Type
    _ty FilteredHWType
    hwTy = FilteredHWType
    hwTy

    -- | Same as @coreTypeToHWType@, but discards void filter information
    coreTypeToHWType'
      :: (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -> CustomReprs
      -> TyConMap
      -> Type
      -- ^ Type to convert to HWType
      -> State HWMap (Either String HWType)
    coreTypeToHWType' :: (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
    coreTypeToHWType' CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty =
      (FilteredHWType -> HWType)
    -> Either [Char] FilteredHWType -> Either [Char] HWType
    forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilteredHWType -> HWType
    stripFiltered (Either [Char] FilteredHWType -> Either [Char] HWType)
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    -> State
         (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    coreTypeToHWType CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty

    -- | Converts a Core type to a HWType given a function that translates certain
    -- builtin types. Returns a string containing the error message when the Core
    -- type is not translatable.
    coreTypeToHWType
      :: (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -> CustomReprs
      -> TyConMap
      -> Type
      -- ^ Type to convert to HWType
      -> State HWMap (Either String FilteredHWType)
    coreTypeToHWType :: (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    coreTypeToHWType CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty = do
      htyM <- Type
    -> Map Type (Either [Char] FilteredHWType)
    -> Maybe (Either [Char] FilteredHWType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Type
    ty (Map Type (Either [Char] FilteredHWType)
     -> Maybe (Either [Char] FilteredHWType))
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Map Type (Either [Char] FilteredHWType))
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT
      (Map Type (Either [Char] FilteredHWType))
      Identity
      (Map Type (Either [Char] FilteredHWType))
    forall s (m :: Type -> Type). MonadState s m => m s
    get
      case htyM of
        Just Either [Char] FilteredHWType
    hty -> Either [Char] FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall a.
    a -> StateT (Map Type (Either [Char] FilteredHWType)) Identity a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Either [Char] FilteredHWType
    hty
        Maybe (Either [Char] FilteredHWType)
    _ -> do
          hty0M <- CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty
          hty1  <- go hty0M ty
          modify (Map.insert ty hty1)
          return hty1
     where
      -- Try builtin translation; for now this is hardcoded to be the one in ghcTypeToHWType
      go :: Maybe (Either String FilteredHWType)
         -> Type
         -> State (Map Type (Either String FilteredHWType))
                  (Either String FilteredHWType)
      go :: Maybe (Either [Char] FilteredHWType)
    -> Type
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    go (Just Either [Char] FilteredHWType
    hwtyE) Type
    _ = Either [Char] FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall a.
    a -> StateT (Map Type (Either [Char] FilteredHWType)) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Either [Char] FilteredHWType
     -> StateT
          (Map Type (Either [Char] FilteredHWType))
          Identity
          (Either [Char] FilteredHWType))
    -> Either [Char] FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall a b. (a -> b) -> a -> b
    $ CustomReprs -> Type -> FilteredHWType -> FilteredHWType
    maybeConvertToCustomRepr CustomReprs
    reprs Type
    ty (FilteredHWType -> FilteredHWType)
    -> Either [Char] FilteredHWType -> Either [Char] FilteredHWType
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Either [Char] FilteredHWType
    hwtyE
      -- Strip transparant types:
      go Maybe (Either [Char] FilteredHWType)
    _ (TyConMap -> Type -> Maybe Type
    coreView1 TyConMap
    m -> Just Type
    ty') =
        (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    coreTypeToHWType CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m Type
    ty'
      -- Try to create hwtype based on AST:
      go Maybe (Either [Char] FilteredHWType)
    _ (Type -> TypeView
    tyView -> TyConApp TyConName
    tc [Type]
    args) = ExceptT
      [Char]
      (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
      FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT
       [Char]
       (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
       FilteredHWType
     -> StateT
          (Map Type (Either [Char] FilteredHWType))
          Identity
          (Either [Char] FilteredHWType))
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall a b. (a -> b) -> a -> b
    $ do
        hwty <- (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> [Char]
    -> TyConName
    -> [Type]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    mkADT CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m (Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type
    ty) TyConName
    tc [Type]
    args
        return (maybeConvertToCustomRepr reprs ty hwty)
      -- All methods failed:
      go Maybe (Either [Char] FilteredHWType)
    _ Type
    _ = Either [Char] FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall a.
    a -> StateT (Map Type (Either [Char] FilteredHWType)) Identity a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Either [Char] FilteredHWType
     -> StateT
          (Map Type (Either [Char] FilteredHWType))
          Identity
          (Either [Char] FilteredHWType))
    -> Either [Char] FilteredHWType
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Either [Char] FilteredHWType
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] FilteredHWType)
    -> [Char] -> Either [Char] FilteredHWType
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Can't translate non-tycon type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall p. PrettyPrec p => p -> [Char]
    showPpr Type
    ty

    -- | Generates original indices in list before filtering, given a list of
    -- removed indices.
    --
    -- >>> originalIndices [False, False, True, False]
    -- [0,1,3]
    originalIndices
      :: [Bool]
      -- ^ Were voids. Length must be less than or equal to n.
      -> [Int]
      -- ^ Original indices
    originalIndices :: [IsVoid] -> [Int]
    originalIndices [IsVoid]
    wereVoids =
      [Int
    i | (Int
    i, IsVoid
    void) <- [Int] -> [IsVoid] -> [(Int, IsVoid)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [IsVoid]
    wereVoids, IsVoid -> IsVoid
    not IsVoid
    void]

    -- | Converts an algebraic Core type (split into a TyCon and its argument) to a HWType.
    mkADT
      :: (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -- ^ Hardcoded Type -> HWType translator
      -> CustomReprs
      -> TyConMap
      -- ^ TyCon cache
      -> String
      -- ^ String representation of the Core type for error messages
      -> TyConName
      -- ^ The TyCon
      -> [Type]
      -- ^ Its applied arguments
      -> ExceptT String (State HWMap) FilteredHWType
      -- ^ An error string or a tuple with the type and possibly a list of
      -- removed arguments.
    mkADT :: (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> [Char]
    -> TyConName
    -> [Type]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    mkADT CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    _ CustomReprs
    _ TyConMap
    m [Char]
    tyString TyConName
    tc [Type]
    _
      | TyConMap -> TyConName -> IsVoid
    isRecursiveTy TyConMap
    m TyConName
    tc
      = [Char]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
    throwE ([Char]
     -> ExceptT
          [Char]
          (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
          FilteredHWType)
    -> [Char]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Can't translate recursive type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    tyString

    mkADT CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m [Char]
    tyString TyConName
    tc [Type]
    args = case TyCon -> [DataCon]
    tyConDataCons (TyConName -> TyConMap -> TyCon
    forall a b. Uniquable a => a -> UniqMap b -> b
    UniqMap.find TyConName
    tc TyConMap
    m) of
      []  -> FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType (Maybe HWType -> HWType
    Void Maybe HWType
    forall a. Maybe a
    Nothing) [])
      [DataCon]
    dcs -> do
        let tcName :: Text
    tcName           = TyConName -> Text
    forall a. Name a -> Text
    nameOcc TyConName
    tc
            substArgTyss :: [[Type]]
    substArgTyss     = (DataCon -> [Type]) -> [DataCon] -> [[Type]]
    forall a b. (a -> b) -> [a] -> [b]
    map (DataCon -> [Type] -> [Type]
    `substArgTys` [Type]
    args) [DataCon]
    dcs
        argHTyss0           <- ([Type]
     -> ExceptT
          [Char]
          (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
          [FilteredHWType])
    -> [[Type]]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         [[FilteredHWType]]
    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
     -> ExceptT
          [Char]
          (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
          FilteredHWType)
    -> [Type]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         [FilteredHWType]
    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 (StateT
      (Map Type (Either [Char] FilteredHWType))
      Identity
      (Either [Char] FilteredHWType)
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
    ExceptT (StateT
       (Map Type (Either [Char] FilteredHWType))
       Identity
       (Either [Char] FilteredHWType)
     -> ExceptT
          [Char]
          (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
          FilteredHWType)
    -> (Type
        -> StateT
             (Map Type (Either [Char] FilteredHWType))
             Identity
             (Either [Char] FilteredHWType))
    -> Type
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> StateT
         (Map Type (Either [Char] FilteredHWType))
         Identity
         (Either [Char] FilteredHWType)
    coreTypeToHWType CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m)) [[Type]]
    substArgTyss
        let argHTyss1        = ([FilteredHWType] -> [(IsVoid, FilteredHWType)])
    -> [[FilteredHWType]] -> [[(IsVoid, FilteredHWType)]]
    forall a b. (a -> b) -> [a] -> [b]
    map (\[FilteredHWType]
    tys -> [IsVoid] -> [FilteredHWType] -> [(IsVoid, FilteredHWType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((FilteredHWType -> IsVoid) -> [FilteredHWType] -> [IsVoid]
    forall a b. (a -> b) -> [a] -> [b]
    map FilteredHWType -> IsVoid
    isFilteredVoid [FilteredHWType]
    tys) [FilteredHWType]
    tys) [[FilteredHWType]]
    argHTyss0
        let areVoids         = ([(IsVoid, FilteredHWType)] -> [IsVoid])
    -> [[(IsVoid, FilteredHWType)]] -> [[IsVoid]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((IsVoid, FilteredHWType) -> IsVoid)
    -> [(IsVoid, FilteredHWType)] -> [IsVoid]
    forall a b. (a -> b) -> [a] -> [b]
    map (IsVoid, FilteredHWType) -> IsVoid
    forall a b. (a, b) -> a
    fst) [[(IsVoid, FilteredHWType)]]
    argHTyss1
        let filteredArgHTyss = ([(IsVoid, FilteredHWType)] -> [FilteredHWType])
    -> [[(IsVoid, FilteredHWType)]] -> [[FilteredHWType]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((IsVoid, FilteredHWType) -> FilteredHWType)
    -> [(IsVoid, FilteredHWType)] -> [FilteredHWType]
    forall a b. (a -> b) -> [a] -> [b]
    map (IsVoid, FilteredHWType) -> FilteredHWType
    forall a b. (a, b) -> b
    snd ([(IsVoid, FilteredHWType)] -> [FilteredHWType])
    -> ([(IsVoid, FilteredHWType)] -> [(IsVoid, FilteredHWType)])
    -> [(IsVoid, FilteredHWType)]
    -> [FilteredHWType]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((IsVoid, FilteredHWType) -> IsVoid)
    -> [(IsVoid, FilteredHWType)] -> [(IsVoid, FilteredHWType)]
    forall a. (a -> IsVoid) -> [a] -> [a]
    filter (IsVoid -> IsVoid
    not (IsVoid -> IsVoid)
    -> ((IsVoid, FilteredHWType) -> IsVoid)
    -> (IsVoid, FilteredHWType)
    -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IsVoid, FilteredHWType) -> IsVoid
    forall a b. (a, b) -> a
    fst)) [[(IsVoid, FilteredHWType)]]
    argHTyss1

        -- Every alternative is annotated with some examples. Be sure to read them.
        case (dcs, filteredArgHTyss) of
          ([DataCon], [[FilteredHWType]])
    _ | (DataCon -> IsVoid) -> [DataCon] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any (TyConMap -> DataCon -> IsVoid
    hasUnconstrainedExistential TyConMap
    m) [DataCon]
    dcs ->
            [Char]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
    throwE ([Char]
     -> ExceptT
          [Char]
          (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
          FilteredHWType)
    -> [Char]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                     [Char]
    "Can't translate data types with unconstrained existentials: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                     [Char]
    tyString
          -- Type has one constructor and that constructor has a single field,
          -- modulo empty fields if keepVoid is False. Examples of such fields
          -- are:
          --
          -- >>> data ABC = ABC Int
          -- >>> data DEF = DEF Int ()
          --
          -- Notice that @DEF@'s constructor has an "empty" second argument. The
          -- second field of FilteredHWType would then look like:
          --
          -- >>> [[False, True]]
          (DataCon
    _:[],[[FilteredHWType
    elemTy]]) ->
            FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType (FilteredHWType -> HWType
    stripFiltered FilteredHWType
    elemTy) [[(IsVoid, FilteredHWType)]]
    argHTyss1)

          -- Type has one constructor, but multiple fields modulo empty fields
          -- (see previous case for more thorough explanation). Examples:
          --
          -- >>> data GHI = GHI Int Int
          -- >>> data JKL = JKL Int () Int
          --
          -- In the second case the second field of FilteredHWType would be
          -- [[False, True, False]]
          ([DataCon -> [Text]
    dcFieldLabels -> [Text]
    labels0],[elemTys :: [FilteredHWType]
    elemTys@(FilteredHWType
    _:[FilteredHWType]
    _)]) -> do
            labelsM <-
              if [Text] -> IsVoid
    forall a. [a] -> IsVoid
    forall (t :: Type -> Type) a. Foldable t => t a -> IsVoid
    null [Text]
    labels0 then
                Maybe [Text]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         (Maybe [Text])
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe [Text]
    forall a. Maybe a
    Nothing
              else
                -- Filter out labels belonging to arguments filtered due to being
                -- void. See argHTyss1.
                let areNotVoids :: [IsVoid]
    areNotVoids = case [[IsVoid]]
    areVoids of
                                    [IsVoid]
    areVoid:[[IsVoid]]
    _ -> (IsVoid -> IsVoid) -> [IsVoid] -> [IsVoid]
    forall a b. (a -> b) -> [a] -> [b]
    map IsVoid -> IsVoid
    not [IsVoid]
    areVoid
                                    [[IsVoid]]
    _ -> [Char] -> [IsVoid]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insufficient areVoids"
                    labels1 :: [(IsVoid, Text)]
    labels1     = ((IsVoid, Text) -> IsVoid) -> [(IsVoid, Text)] -> [(IsVoid, Text)]
    forall a. (a -> IsVoid) -> [a] -> [a]
    filter (IsVoid, Text) -> IsVoid
    forall a b. (a, b) -> a
    fst ([IsVoid] -> [Text] -> [(IsVoid, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [IsVoid]
    areNotVoids [Text]
    labels0)
                    labels2 :: [Text]
    labels2     = ((IsVoid, Text) -> Text) -> [(IsVoid, Text)] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (IsVoid, Text) -> Text
    forall a b. (a, b) -> b
    snd [(IsVoid, Text)]
    labels1
                 in Maybe [Text]
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         (Maybe [Text])
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([Text] -> Maybe [Text]
    forall a. a -> Maybe a
    Just [Text]
    labels2)
            let hwty = Text -> Maybe [Text] -> [HWType] -> HWType
    Product Text
    tcName Maybe [Text]
    labelsM ((FilteredHWType -> HWType) -> [FilteredHWType] -> [HWType]
    forall a b. (a -> b) -> [a] -> [b]
    map FilteredHWType -> HWType
    stripFiltered [FilteredHWType]
    elemTys)
            return (FilteredHWType hwty argHTyss1)

          -- Either none of the constructors have fields, or they have been filtered
          -- due to them being empty. Examples:
          --
          -- >>> data MNO = M    | N | O
          -- >>> data PQR = P () | Q | R ()
          -- >>> data STU = STU
          -- >>> data VWX
          ([DataCon]
    _, [[FilteredHWType]] -> [FilteredHWType]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat -> [])
            -- If none of the dataconstructors have fields, and there are 1 or less
            -- of them, this type only has one inhabitant. It can therefore be
            -- represented by zero bits, and is therefore empty:
            | [DataCon] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [DataCon]
    dcs Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    <= Int
    1 -> case [[FilteredHWType]]
    argHTyss0 of
                [[FilteredHWType]
    argHTys0] ->
                  -- We need this to preserve constraint-tuples of `KnownDomains`
                  let argHTys1 :: [HWType]
    argHTys1 = (FilteredHWType -> HWType) -> [FilteredHWType] -> [HWType]
    forall a b. (a -> b) -> [a] -> [b]
    map (HWType -> HWType
    stripVoid (HWType -> HWType)
    -> (FilteredHWType -> HWType) -> FilteredHWType -> HWType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilteredHWType -> HWType
    stripFiltered) [FilteredHWType]
    argHTys0
                  in  FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType
                                (Maybe HWType -> HWType
    Void (HWType -> Maybe HWType
    forall a. a -> Maybe a
    Just (Text -> Maybe [Text] -> [HWType] -> HWType
    Product Text
    tcName Maybe [Text]
    forall a. Maybe a
    Nothing [HWType]
    argHTys1)))
                                [[(IsVoid, FilteredHWType)]]
    argHTyss1)
                [[FilteredHWType]]
    _ -> FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType (Maybe HWType -> HWType
    Void Maybe HWType
    forall a. Maybe a
    Nothing) [[(IsVoid, FilteredHWType)]]
    argHTyss1)
            -- None of the dataconstructors have fields. This type is therefore a
            -- simple Sum type.
            | IsVoid
    otherwise ->
              FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType (Text -> [Text] -> HWType
    Sum Text
    tcName ([Text] -> HWType) -> [Text] -> HWType
    forall a b. (a -> b) -> a -> b
    $ (DataCon -> Text) -> [DataCon] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name DataCon -> Text
    forall a. Name a -> Text
    nameOcc (Name DataCon -> Text)
    -> (DataCon -> Name DataCon) -> DataCon -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataCon -> Name DataCon
    dcName) [DataCon]
    dcs) [[(IsVoid, FilteredHWType)]]
    argHTyss1)

          -- A sum of product, due to multiple constructors, where at least one
          -- of the constructor has one or more fields modulo empty fields. Example:
          --
          -- >>> data YZA = Y Int | Z () | A
          ([DataCon]
    _,[[FilteredHWType]]
    elemHTys) ->
            FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a.
    a
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (FilteredHWType
     -> ExceptT
          [Char]
          (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
          FilteredHWType)
    -> FilteredHWType
    -> ExceptT
         [Char]
         (StateT (Map Type (Either [Char] FilteredHWType)) Identity)
         FilteredHWType
    forall a b. (a -> b) -> a -> b
    $ HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType (Text -> [(Text, [HWType])] -> HWType
    SP Text
    tcName ([(Text, [HWType])] -> HWType) -> [(Text, [HWType])] -> HWType
    forall a b. (a -> b) -> a -> b
    $ (DataCon -> [HWType] -> (Text, [HWType]))
    -> [DataCon] -> [[HWType]] -> [(Text, [HWType])]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith
              (\DataCon
    dc [HWType]
    tys ->  ( Name DataCon -> Text
    forall a. Name a -> Text
    nameOcc (DataCon -> Name DataCon
    dcName DataCon
    dc), [HWType]
    tys))
              [DataCon]
    dcs ((FilteredHWType -> HWType) -> [FilteredHWType] -> [HWType]
    forall a b. (a -> b) -> [a] -> [b]
    map FilteredHWType -> HWType
    stripFiltered ([FilteredHWType] -> [HWType]) -> [[FilteredHWType]] -> [[HWType]]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[FilteredHWType]]
    elemHTys)) [[(IsVoid, FilteredHWType)]]
    argHTyss1

    -- | Determine whether a data constructor has unconstrained existential type
    -- variables, i.e. those that cannot be inferred by the (potential) constraints
    -- between the existential type variables and universal type variables.
    --
    -- So here we have an example of a constrained existential:
    --
    -- data Vec :: Nat -> Type -> Type
    --  where
    --   Nil  :: Vec 0 a
    --   Cons :: forall m . (n ~ m + 1) => a -> Vec m a -> Vec n a
    --
    -- where we can generate a type for `m` when we know `n` (by doing `n-1`).
    --
    -- And here is an example of an unconstrained existential:
    --
    -- data SomeSNat where
    --  where
    --   SomeSNat :: forall m . SNat m -> SomeSNat
    --
    -- where there is no way to generate a type for `m` from any context.
    --
    -- So why do we care? Because terms need to be completely monomorphic in order
    -- to be translated to circuits. And having a topEntity lambda-bound variable
    -- with an unconstrained existential type prevents us from achieving a fully
    -- monomorphic term.
    hasUnconstrainedExistential
      :: TyConMap
      -> DataCon
      -> Bool
    hasUnconstrainedExistential :: TyConMap -> DataCon -> IsVoid
    hasUnconstrainedExistential TyConMap
    tcm DataCon
    dc =
      let eTVs :: [TyVar]
    eTVs        = DataCon -> [TyVar]
    dcExtTyVars DataCon
    dc
          uTVs :: [TyVar]
    uTVs        = DataCon -> [TyVar]
    dcUnivTyVars DataCon
    dc
          constraints :: [(Type, Type)]
    constraints = (Type -> Maybe (Type, Type)) -> [Type] -> [(Type, Type)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (TyConMap -> Type -> Maybe (Type, Type)
    typeEq TyConMap
    tcm) (DataCon -> [Type]
    dcArgTys DataCon
    dc)

          -- Is the existential `eTV` constrained by the constraint `(ty1,ty2)`
          isConstrainedBy :: TyVar -> (Type, Type) -> IsVoid
    isConstrainedBy TyVar
    eTV (Type
    ty1,Type
    ty2) =
            let -- Free FVs in the LHS and RHS of the constraint that are not the
                -- in the set of universal type variables of the constructor.
                ty1FEVs :: [Var a]
    ty1FEVs = Getting (Endo [Var a]) Type (Var a) -> Type -> [Var a]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    Lens.toListOf ((forall b. Var b -> IsVoid)
    -> Word64Set -> Getting (Endo [Var a]) Type (Var a)
    forall (f :: Type -> Type) a.
    (Contravariant f, Applicative f) =>
    (forall b. Var b -> IsVoid)
    -> Word64Set -> (Var a -> f (Var a)) -> Type -> f Type
    typeFreeVars' ((TyVar -> [TyVar] -> IsVoid
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> IsVoid
    `notElem` [TyVar]
    uTVs) (TyVar -> IsVoid) -> (Var b -> TyVar) -> Var b -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Var b -> TyVar
    forall a b. Coercible a b => a -> b
    coerce)
                                                       Word64Set
    forall a. Monoid a => a
    mempty)
                                        Type
    ty1
                ty2FEVs :: [Var a]
    ty2FEVs = Getting (Endo [Var a]) Type (Var a) -> Type -> [Var a]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    Lens.toListOf ((forall b. Var b -> IsVoid)
    -> Word64Set -> Getting (Endo [Var a]) Type (Var a)
    forall (f :: Type -> Type) a.
    (Contravariant f, Applicative f) =>
    (forall b. Var b -> IsVoid)
    -> Word64Set -> (Var a -> f (Var a)) -> Type -> f Type
    typeFreeVars' ((TyVar -> [TyVar] -> IsVoid
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> IsVoid
    `notElem` [TyVar]
    uTVs) (TyVar -> IsVoid) -> (Var b -> TyVar) -> Var b -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Var b -> TyVar
    forall a b. Coercible a b => a -> b
    coerce)
                                                       Word64Set
    forall a. Monoid a => a
    mempty)
                                        Type
    ty2

                -- Determine whether `eTV` can be generated from one side of a
                -- constraint, under the assumption that the other side of the
                -- constraint mentions no existential type variables.
                isGenerative ::
                  -- Side (LHS or RHS) of a constraint
                  Type ->
                  -- Its free type variables (that are no in the set of universal
                  -- type variables)
                  [TyVar] ->
                  Bool
                isGenerative :: Type -> [TyVar] -> IsVoid
    isGenerative Type
    t [TyVar]
    efvs = case Type -> TypeView
    tyView Type
    t of
                  TyConApp TyConName
    tcNm [Type]
    _
                    | Just (FunTyCon {}) <- TyConName -> TyConMap -> Maybe TyCon
    forall a b. Uniquable a => a -> UniqMap b -> Maybe b
    UniqMap.lookup TyConName
    tcNm TyConMap
    tcm
                    -- For type families we can only "calculate" the `eTV` if it is
                    -- the only free variable. e.g. we can work out from `n + 1 ~ 4`
                    -- that `n ~ 3`, but can't do anything for `n + m ~ 4`.
                    -> [TyVar
    eTV] [TyVar] -> [TyVar] -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == [TyVar]
    efvs
                    | IsVoid
    otherwise
                    -- Normal type constructors are fully generative, e.g. given:
                    -- DomainConfiguration a b ~ DomainConfiguration "System" 10000
                    --
                    -- we can infer both `a ~ "System"` and `b ~ 10000`
                    -> TyVar
    eTV TyVar -> [TyVar] -> IsVoid
    forall a. Eq a => a -> [a] -> IsVoid
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> IsVoid
    `elem` [TyVar]
    efvs
                  FunTy {}
                    -- Functions are also fully generative
                    -> TyVar
    eTV TyVar -> [TyVar] -> IsVoid
    forall a. Eq a => a -> [a] -> IsVoid
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> IsVoid
    `elem` [TyVar]
    efvs
                  OtherType Type
    other -> case Type
    other of
                    VarTy TyVar
    v -> TyVar
    v TyVar -> TyVar -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == TyVar
    eTV
                    LitTy LitTy
    _ -> IsVoid
    False
                    -- Anything else, like some higher-kinded quantified type we
                    -- just give up for now. TODO: implement this
                    Type
    _ -> IsVoid
    False

                onlyTy1 :: IsVoid
    onlyTy1 = Type -> [TyVar] -> IsVoid
    isGenerative Type
    ty1 [TyVar]
    forall {a}. [Var a]
    ty1FEVs IsVoid -> IsVoid -> IsVoid
    && [Var (ZonkAny 0)] -> IsVoid
    forall a. [a] -> IsVoid
    forall (t :: Type -> Type) a. Foldable t => t a -> IsVoid
    null [Var (ZonkAny 0)]
    forall {a}. [Var a]
    ty2FEVs
                onlyTy2 :: IsVoid
    onlyTy2 = Type -> [TyVar] -> IsVoid
    isGenerative Type
    ty2 [TyVar]
    forall {a}. [Var a]
    ty2FEVs IsVoid -> IsVoid -> IsVoid
    && [Var (ZonkAny 1)] -> IsVoid
    forall a. [a] -> IsVoid
    forall (t :: Type -> Type) a. Foldable t => t a -> IsVoid
    null [Var (ZonkAny 1)]
    forall {a}. [Var a]
    ty1FEVs
            in  IsVoid
    onlyTy1 IsVoid -> IsVoid -> IsVoid
    || IsVoid
    onlyTy2

          -- The existential type variables that are not constrained by any of the
          -- constraints.
          unconstrainedETVs :: [TyVar]
    unconstrainedETVs =
            (TyVar -> IsVoid) -> [TyVar] -> [TyVar]
    forall a. (a -> IsVoid) -> [a] -> [a]
    filter (\TyVar
    v -> IsVoid -> IsVoid
    not (((Type, Type) -> IsVoid) -> [(Type, Type)] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any (TyVar -> (Type, Type) -> IsVoid
    isConstrainedBy TyVar
    v) [(Type, Type)]
    constraints)) [TyVar]
    eTVs

      in  IsVoid -> IsVoid
    not ([TyVar] -> IsVoid
    forall a. [a] -> IsVoid
    forall (t :: Type -> Type) a. Foldable t => t a -> IsVoid
    null [TyVar]
    unconstrainedETVs)

    -- | Simple check if a TyCon is recursively defined.
    --
    -- Note [Look through type families in recursivity check]
    --
    -- Consider:
    --
    -- @
    -- data SList :: [Type] -> Type where
    --   SNil  :: SList []
    --   CSons :: a -> Sing (as :: [k]) -> SList (a:as)
    --
    -- type family Sing [a] = SList [a]
    -- @
    --
    -- Without looking through type families, we would think that /SList/ is not
    -- recursive. This lead to issue #1921
    isRecursiveTy :: TyConMap -> TyConName -> Bool
    isRecursiveTy :: TyConMap -> TyConName -> IsVoid
    isRecursiveTy TyConMap
    m TyConName
    tc = case TyCon -> [DataCon]
    tyConDataCons (TyConName -> TyConMap -> TyCon
    forall a b. Uniquable a => a -> UniqMap b -> b
    UniqMap.find TyConName
    tc TyConMap
    m) of
        []  -> IsVoid
    False
        [DataCon]
    dcs -> let argTyss :: [[Type]]
    argTyss   = (DataCon -> [Type]) -> [DataCon] -> [[Type]]
    forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> [Type]
    dcArgTys [DataCon]
    dcs
                   argTycons :: [TyConName]
    argTycons = (((TyConName, [Type]) -> TyConName)
    -> [(TyConName, [Type])] -> [TyConName]
    forall a b. (a -> b) -> [a] -> [b]
    map (TyConName, [Type]) -> TyConName
    forall a b. (a, b) -> a
    fst ([(TyConName, [Type])] -> [TyConName])
    -> ([Maybe (TyConName, [Type])] -> [(TyConName, [Type])])
    -> [Maybe (TyConName, [Type])]
    -> [TyConName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (TyConName, [Type])] -> [(TyConName, [Type])]
    forall a. [Maybe a] -> [a]
    catMaybes)
                             ([Maybe (TyConName, [Type])] -> [TyConName])
    -> [Maybe (TyConName, [Type])] -> [TyConName]
    forall a b. (a -> b) -> a -> b
    $ (([Type] -> [Maybe (TyConName, [Type])])
    -> [[Type]] -> [Maybe (TyConName, [Type])]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (([Type] -> [Maybe (TyConName, [Type])])
     -> [[Type]] -> [Maybe (TyConName, [Type])])
    -> ((Type -> Maybe (TyConName, [Type]))
        -> [Type] -> [Maybe (TyConName, [Type])])
    -> (Type -> Maybe (TyConName, [Type]))
    -> [[Type]]
    -> [Maybe (TyConName, [Type])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> Maybe (TyConName, [Type]))
    -> [Type] -> [Maybe (TyConName, [Type])]
    forall a b. (a -> b) -> [a] -> [b]
    map)
                                   -- Note [Look through type families in recursivity check]
                                   (Type -> Maybe (TyConName, [Type])
    splitTyConAppM (Type -> Maybe (TyConName, [Type]))
    -> (Type -> Type) -> Type -> Maybe (TyConName, [Type])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyConMap -> Type -> Type
    normalizeType TyConMap
    m)
                                   [[Type]]
    argTyss
               in TyConName
    tc TyConName -> [TyConName] -> IsVoid
    forall a. Eq a => a -> [a] -> IsVoid
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> IsVoid
    `elem` [TyConName]
    argTycons

    -- | Determines if a Core type is translatable to a HWType given a function that
    -- translates certain builtin types.
    representableType
      :: (CustomReprs -> TyConMap -> Type ->
          State HWMap (Maybe (Either String FilteredHWType)))
      -> CustomReprs
      -> Bool
      -- ^ String considered representable
      -> TyConMap
      -> Type
      -> Bool
    representableType :: (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs -> IsVoid -> TyConMap -> Type -> IsVoid
    representableType CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs IsVoid
    stringRepresentable TyConMap
    m =
        ([Char] -> IsVoid)
    -> (HWType -> IsVoid) -> Either [Char] HWType -> IsVoid
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (IsVoid -> [Char] -> IsVoid
    forall a b. a -> b -> a
    const IsVoid
    False) HWType -> IsVoid
    isRepresentable (Either [Char] HWType -> IsVoid)
    -> (Type -> Either [Char] HWType) -> Type -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (State
       (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
     -> Map Type (Either [Char] FilteredHWType) -> Either [Char] HWType)
    -> Map Type (Either [Char] FilteredHWType)
    -> State
         (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
    -> Either [Char] HWType
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip State
      (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
    -> Map Type (Either [Char] FilteredHWType) -> Either [Char] HWType
    forall s a. State s a -> s -> a
    evalState Map Type (Either [Char] FilteredHWType)
    forall a. Monoid a => a
    mempty (State
       (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
     -> Either [Char] HWType)
    -> (Type
        -> State
             (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType))
    -> Type
    -> Either [Char] HWType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (CustomReprs
     -> TyConMap
     -> Type
     -> State
          (Map Type (Either [Char] FilteredHWType))
          (Maybe (Either [Char] FilteredHWType)))
    -> CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType)) (Either [Char] HWType)
    coreTypeToHWType' CustomReprs
    -> TyConMap
    -> Type
    -> State
         (Map Type (Either [Char] FilteredHWType))
         (Maybe (Either [Char] FilteredHWType))
    builtInTranslation CustomReprs
    reprs TyConMap
    m
      where
        isRepresentable :: HWType -> IsVoid
    isRepresentable HWType
    hty = case HWType
    hty of
          HWType
    String            -> IsVoid
    stringRepresentable
          Vector Int
    _ HWType
    elTy     -> HWType -> IsVoid
    isRepresentable HWType
    elTy
          RTree  Int
    _ HWType
    elTy     -> HWType -> IsVoid
    isRepresentable HWType
    elTy
          Product Text
    _ Maybe [Text]
    _ [HWType]
    elTys -> (HWType -> IsVoid) -> [HWType] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    all HWType -> IsVoid
    isRepresentable [HWType]
    elTys
          SP Text
    _ [(Text, [HWType])]
    elTyss       -> ((Text, [HWType]) -> IsVoid) -> [(Text, [HWType])] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    all ((HWType -> IsVoid) -> [HWType] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    all HWType -> IsVoid
    isRepresentable ([HWType] -> IsVoid)
    -> ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) [(Text, [HWType])]
    elTyss
          BiDirectional PortDirection
    _ HWType
    t -> HWType -> IsVoid
    isRepresentable HWType
    t
          Annotated [Attr Text]
    _ HWType
    ty    -> HWType -> IsVoid
    isRepresentable HWType
    ty
          HWType
    _                 -> IsVoid
    True

    -- | Determines the bitsize of a type. For types that don't get turned
    -- into real values in hardware (string, integer) the size is 0.
    typeSize :: HWType
             -> Int
    typeSize :: HWType -> Int
    typeSize (Void {}) = Int
    0
    typeSize HWType
    FileType = Int
    32 -- (ref. page 287 of IEEE 1364-2005)
    typeSize HWType
    String = Int
    0
    typeSize HWType
    Integer = Int
    0
    typeSize (KnownDomain {}) = Int
    0
    typeSize HWType
    Bool = Int
    1
    typeSize HWType
    Bit = Int
    1
    typeSize (Clock Text
    _) = Int
    1
    typeSize (ClockN Text
    _) = Int
    1
    typeSize (Reset Text
    _) = Int
    1
    typeSize (Enable Text
    _) = Int
    1
    typeSize (BitVector Int
    i) = Int
    i
    typeSize (Index Integer
    0) = Int
    0
    typeSize (Index Integer
    1) = Int
    1
    typeSize (Index Integer
    u) = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Integer -> Integer -> Maybe Int
    clogBase Integer
    2 Integer
    u)
    typeSize (Signed Int
    i) = Int
    i
    typeSize (Unsigned Int
    i) = Int
    i
    typeSize (Vector Int
    n HWType
    el) = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * HWType -> Int
    typeSize HWType
    el
    typeSize (MemBlob Int
    n Int
    m) = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    m
    typeSize (RTree Int
    d HWType
    el) = (Int
    2Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Int
    d) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * HWType -> Int
    typeSize HWType
    el
    typeSize t :: HWType
    t@(SP Text
    _ [(Text, [HWType])]
    cons) = HWType -> Int
    conSize HWType
    t Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +
      [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
    maximum (((Text, [HWType]) -> Int) -> [(Text, [HWType])] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int)
    -> ((Text, [HWType]) -> [Int]) -> (Text, [HWType]) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HWType -> Int) -> [HWType] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map HWType -> Int
    typeSize ([HWType] -> [Int])
    -> ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) [(Text, [HWType])]
    cons)
    typeSize (Sum Text
    _ [Text]
    dcs) = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> (Int -> Maybe Int) -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Integer -> Maybe Int
    clogBase Integer
    2 (Integer -> Maybe Int) -> (Int -> Integer) -> Int -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Text]
    dcs
    typeSize (Product Text
    _ Maybe [Text]
    _ [HWType]
    tys) = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (HWType -> Int) -> [HWType] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map HWType -> Int
    typeSize [HWType]
    tys
    typeSize (BiDirectional PortDirection
    In HWType
    h) = HWType -> Int
    typeSize HWType
    h
    typeSize (BiDirectional PortDirection
    Out HWType
    _) = Int
    0
    typeSize (CustomSP Text
    _ DataRepr'
    _ Int
    size [(ConstrRepr', Text, [HWType])]
    _) = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size
    typeSize (CustomSum Text
    _ DataRepr'
    _ Int
    size [(ConstrRepr', Text)]
    _) = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size
    typeSize (CustomProduct Text
    _ DataRepr'
    _ Int
    size Maybe [Text]
    _ [(Integer, HWType)]
    _) = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size
    typeSize (Annotated [Attr Text]
    _ HWType
    ty) = HWType -> Int
    typeSize HWType
    ty

    -- | Determines the bitsize of the constructor of a type
    conSize :: HWType
            -> Int
    conSize :: HWType -> Int
    conSize (SP Text
    _ [(Text, [HWType])]
    cons) = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> (Int -> Maybe Int) -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Integer -> Maybe Int
    clogBase Integer
    2 (Integer -> Maybe Int) -> (Int -> Integer) -> Int -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [(Text, [HWType])] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [(Text, [HWType])]
    cons
    conSize HWType
    t           = HWType -> Int
    typeSize HWType
    t

    -- | Gives the HWType corresponding to a term. Returns an error if the term has
    -- a Core type that is not translatable to a HWType.
    termHWType :: String
               -> Term
               -> NetlistMonad HWType
    termHWType :: [Char] -> Term -> NetlistMonad HWType
    termHWType [Char]
    loc Term
    e = do
      m <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
      let ty = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    m Term
    e
      stripFiltered <$> unsafeCoreTypeToHWTypeM loc ty

    -- | Gives the HWType corresponding to a term. Returns 'Nothing' if the term has
    -- a Core type that is not translatable to a HWType.
    termHWTypeM
      :: Term
      -- ^ Term to convert to HWType
      -> NetlistMonad (Maybe FilteredHWType)
    termHWTypeM :: Term -> NetlistMonad (Maybe FilteredHWType)
    termHWTypeM Term
    e = do
      m  <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
      let ty = TyConMap -> Term -> Type
    forall a. InferType a => TyConMap -> a -> Type
    inferCoreTypeOf TyConMap
    m Term
    e
      coreTypeToHWTypeM ty

    isBiSignalIn :: HWType -> Bool
    isBiSignalIn :: HWType -> IsVoid
    isBiSignalIn (BiDirectional PortDirection
    In HWType
    _) = IsVoid
    True
    isBiSignalIn (Annotated [Attr Text]
    _ HWType
    ty)     = HWType -> IsVoid
    isBiSignalIn HWType
    ty
    isBiSignalIn HWType
    _                    = IsVoid
    False

    isBiSignalOut :: HWType -> Bool
    isBiSignalOut :: HWType -> IsVoid
    isBiSignalOut (BiDirectional PortDirection
    Out HWType
    _) = IsVoid
    True
    isBiSignalOut (Annotated [Attr Text]
    _ HWType
    ty)      = HWType -> IsVoid
    isBiSignalOut HWType
    ty
    isBiSignalOut HWType
    _                     = IsVoid
    False

    containsBiSignalIn
      :: HWType
      -> Bool
    containsBiSignalIn :: HWType -> IsVoid
    containsBiSignalIn (BiDirectional PortDirection
    In HWType
    _) = IsVoid
    True
    containsBiSignalIn (Product Text
    _ Maybe [Text]
    _ [HWType]
    tys) = (HWType -> IsVoid) -> [HWType] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any HWType -> IsVoid
    containsBiSignalIn [HWType]
    tys
    containsBiSignalIn (SP Text
    _ [(Text, [HWType])]
    tyss)       = ((Text, [HWType]) -> IsVoid) -> [(Text, [HWType])] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any ((HWType -> IsVoid) -> [HWType] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any HWType -> IsVoid
    containsBiSignalIn ([HWType] -> IsVoid)
    -> ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) [(Text, [HWType])]
    tyss
    containsBiSignalIn (Vector Int
    _ HWType
    ty)     = HWType -> IsVoid
    containsBiSignalIn HWType
    ty
    containsBiSignalIn (RTree Int
    _ HWType
    ty)      = HWType -> IsVoid
    containsBiSignalIn HWType
    ty
    containsBiSignalIn (Annotated [Attr Text]
    _ HWType
    ty)  = HWType -> IsVoid
    containsBiSignalIn HWType
    ty
    containsBiSignalIn HWType
    _                 = IsVoid
    False

    -- | Uniquely rename all the variables and their references in a normalized
    -- term
    mkUniqueNormalized
      :: HasCallStack
      => InScopeSet
      -> Maybe (Maybe TopEntity)
      -- ^ Top entity annotation where:
      --
      --     * Nothing: term is not a top entity
      --     * Just Nothing: term is a top entity, but has no explicit annotation
      --     * Just (Just ..): term is a top entity, and has an explicit annotation
      -> ( [Id]
         , [LetBinding]
         , Id
         )
      -> NetlistMonad
          ([Bool]
          ,[(Identifier,HWType)]
          ,[Declaration]
          ,[(Identifier,HWType)]
          ,[Declaration]
          ,[LetBinding]
          ,Maybe Id)
    mkUniqueNormalized :: HasCallStack =>
    InScopeSet
    -> Maybe (Maybe TopEntity)
    -> ([Id], [LetBinding], Id)
    -> NetlistMonad
         ([IsVoid], [(Identifier, HWType)], [Declaration],
          [(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
    mkUniqueNormalized InScopeSet
    is0 Maybe (Maybe TopEntity)
    topMM ([Id]
    args, [LetBinding]
    binds, Id
    res) = do
      -- Generate port names and add them to set of seen identifiers
      argHwtys <- (Id -> NetlistMonad FilteredHWType)
    -> [Id] -> NetlistMonad [FilteredHWType]
    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 FilteredHWType
    unsafeCoreTypeToHWTypeM $(curLoc) (Type -> NetlistMonad FilteredHWType)
    -> (Id -> Type) -> Id -> NetlistMonad FilteredHWType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf) [Id]
    args
      resHwty <- unsafeCoreTypeToHWTypeM $(curLoc) (coreTypeOf res)
      etopM <-
        mapM
          (expandTopEntityOrErrM (zip (map Just args) argHwtys) (Just res, resHwty))
          topMM

      -- Make arguments unique
      let (bndrs, exprs) = unzip binds
      let is1 = InScopeSet
    is0 InScopeSet -> [Id] -> InScopeSet
    forall a. InScopeSet -> [Var a] -> InScopeSet
    `extendInScopeSetList` ([Id]
    args [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    bndrs)
      (wereVoids, iports, iwrappers, substArgs) <-
        mkUniqueArguments (mkSubst is1) etopM args

      -- Make result unique. This might yield 'Nothing' in which case the result
      -- was a single BiSignalOut. This is superfluous in the HDL, as the argument
      -- will already contain a bidirectional signal complementing the BiSignalOut.
      resM <- mkUniqueResult substArgs etopM res
      case resM of
        Just ([(Identifier, HWType)]
    oports, [Declaration]
    owrappers, Id
    res1, Subst
    subst0) -> do
          -- Collect new names, see 'renameBinder' for more information
          (listToMaybe -> resRenameM0, HashMap.fromList -> renames0) <-
            ((Id, Id) -> IsVoid) -> [(Id, Id)] -> ([(Id, Id)], [(Id, Id)])
    forall a. (a -> IsVoid) -> [a] -> ([a], [a])
    partition ((Id -> Id -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Id
    res) (Id -> IsVoid) -> ((Id, Id) -> Id) -> (Id, Id) -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, Id) -> Id
    forall a b. (a, b) -> a
    fst) ([(Id, Id)] -> ([(Id, Id)], [(Id, Id)]))
    -> NetlistMonad [(Id, Id)] -> NetlistMonad ([(Id, Id)], [(Id, Id)])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (LetBinding -> NetlistMonad [(Id, Id)])
    -> [LetBinding] -> NetlistMonad [(Id, Id)]
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m [b]) -> [a] -> m [b]
    concatMapM LetBinding -> NetlistMonad [(Id, Id)]
    renameBinder [LetBinding]
    binds

          let
            -- Is the result variable read by any of the other binders? In that case
            -- we need to add a redirection as most synthesis tools don't allow reads
            -- from output ports. Note that if the result is renamed anyway, we don't
            -- have to do anything here.
            resultRead = (Term -> IsVoid) -> [Term] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any (Id -> Term -> IsVoid
    forall a. HasFreeVars a => Var a -> a -> IsVoid
    elemFreeVars Id
    res) [Term]
    exprs
            recResult = (Name Term -> Name Term) -> Id -> Id
    forall a. (Name a -> Name a) -> Var a -> Var a
    modifyVarName (Name Term -> Text -> Name Term
    forall a. Name a -> Text -> Name a
    `appendToName` Text
    "_rec") Id
    res
            resRenameM1 = Maybe (Id, Id)
    resRenameM0 Maybe (Id, Id) -> Maybe (Id, Id) -> Maybe (Id, Id)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> IsVoid -> (Id, Id) -> Maybe (Id, Id)
    forall a. IsVoid -> a -> Maybe a
    orNothing IsVoid
    resultRead (Id
    res, Id
    recResult)

          (resN, extraBind, subst1) <-
            case resRenameM1 of
              Maybe (Id, Id)
    Nothing ->
                -- Result binder was not renamed, so we can assign result expression
                -- directly to new name given by 'res1'
                (Id, Maybe LetBinding, Subst)
    -> NetlistMonad (Id, Maybe LetBinding, Subst)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Id
    res1, Maybe LetBinding
    forall a. Maybe a
    Nothing, Subst
    subst0)
              Just (Id
    _, Id
    newName0) -> do
                -- Result binder was renamed. We cannot rename 'res1', so we need
                -- to create an indirection.
                ([newName1], s) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
    mkUnique Subst
    subst0 [Id
    newName0]
                pure (newName1, Just (res1, Var newName1), s)

          let
            -- Result binder is already unique, so don't rename that
            renames1 = [(Id
    b, Id -> Id -> HashMap Id Id -> Id
    forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
    hmFindWithDefault Id
    b Id
    b HashMap Id Id
    renames0) | Id
    b <- [Id]
    bndrs]
            (renamesL0, renamesR0) = case break ((==res) . fst) renames1 of
              ([(Id, Id)]
    ls,(Id, Id)
    _:[(Id, Id)]
    rs) -> ([(Id, Id)]
    ls,[(Id, Id)]
    rs)
              ([(Id, Id)], [(Id, Id)])
    _ -> [Char] -> ([(Id, Id)], [(Id, Id)])
    forall a. HasCallStack => [Char] -> a
    error ([[Char]] -> [Char]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [ [Char]
    "internal error: unable to find: "
                                 , Id -> [Char]
    forall a. Show a => a -> [Char]
    show Id
    res , [Char]
    " in: "
                                 , [(Id, Id)] -> [Char]
    forall a. Show a => a -> [Char]
    show [(Id, Id)]
    renames1 ])

          (renamesL1, subst2) <- mkUnique subst1 (map snd renamesL0)
          (renamesR1, subst3) <- mkUnique subst2 (map snd renamesR0)

          let
            exprs1 = (Term -> Term) -> [Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (HasCallStack => Doc () -> Subst -> Term -> Term
    Doc () -> Subst -> Term -> Term
    substTm Doc ()
    "mkUniqueNormalized1" Subst
    subst3) [Term]
    exprs
            binds0 = [Id] -> [Term] -> [LetBinding]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([Id]
    renamesL1 [Id] -> [Id] -> [Id]
    forall a. Semigroup a => a -> a -> a
    <> [Id
    resN] [Id] -> [Id] -> [Id]
    forall a. Semigroup a => a -> a -> a
    <> [Id]
    renamesR1) [Term]
    exprs1
            binds1 = [LetBinding]
    binds0 [LetBinding] -> [LetBinding] -> [LetBinding]
    forall a. Semigroup a => a -> a -> a
    <> Maybe LetBinding -> [LetBinding]
    forall a. Maybe a -> [a]
    maybeToList Maybe LetBinding
    extraBind

          -- Return the uniquely named arguments, let-binders, and result
          return (wereVoids, iports, iwrappers, oports, owrappers, binds1, Just res1)

        Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    Nothing -> do
          (bndrs1, substArgs1) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
    mkUnique Subst
    substArgs [Id]
    bndrs
          let binds1 = [Id] -> [Term] -> [LetBinding]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Id]
    bndrs1 ((Term -> Term) -> [Term] -> [Term]
    forall a b. (a -> b) -> [a] -> [b]
    map (HasCallStack => Doc () -> Subst -> Term -> Term
    Doc () -> Subst -> Term -> Term
    substTm Doc ()
    "mkUniqueNormalized2" Subst
    substArgs1) [Term]
    exprs)
          return (wereVoids, iports, iwrappers, [], [], binds1, Nothing)

    -- | Produce a 'Just' when predicate is True, else Nothing
    orNothing :: Bool -> a -> Maybe a
    orNothing :: forall a. IsVoid -> a -> Maybe a
    orNothing IsVoid
    True a
    a = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a
    orNothing IsVoid
    False a
    _ = Maybe a
    forall a. Maybe a
    Nothing

    -- | Set the name of the binder if the given term is a blackbox requesting
    -- a specific name for the result binder. It might return multiple names in
    -- case of a multi result primitive.
    --
    renameBinder :: (Id, Term) -> NetlistMonad [(Id, Id)]
    renameBinder :: LetBinding -> NetlistMonad [(Id, Id)]
    renameBinder (Id
    i, Term -> (Term, [Either Term Type], [TickInfo])
    collectArgsTicks -> (Term
    k, [Either Term Type]
    args, [TickInfo]
    ticks)) = [TickInfo]
    -> ([Declaration] -> NetlistMonad [(Id, Id)])
    -> NetlistMonad [(Id, Id)]
    forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks (([Declaration] -> NetlistMonad [(Id, Id)])
     -> NetlistMonad [(Id, Id)])
    -> ([Declaration] -> NetlistMonad [(Id, Id)])
    -> NetlistMonad [(Id, Id)]
    forall a b. (a -> b) -> a -> b
    $ \[Declaration]
    _ -> do
      case Term
    k of
        Prim PrimInfo
    p ->
          case PrimInfo -> IsMultiPrim
    primMultiResult PrimInfo
    p of
            IsMultiPrim
    SingleResult -> HasCallStack => Text -> NetlistMonad CompiledPrimitive
    Text -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail (PrimInfo -> Text
    primName PrimInfo
    p) NetlistMonad CompiledPrimitive
    -> (CompiledPrimitive -> NetlistMonad [(Id, Id)])
    -> NetlistMonad [(Id, Id)]
    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 [(Id, Id)]
    goSingle PrimInfo
    p
            IsMultiPrim
    MultiResult -> HasCallStack => Text -> NetlistMonad CompiledPrimitive
    Text -> NetlistMonad CompiledPrimitive
    extractPrimWarnOrFail (PrimInfo -> Text
    primName PrimInfo
    p) NetlistMonad CompiledPrimitive
    -> (CompiledPrimitive -> NetlistMonad [(Id, Id)])
    -> NetlistMonad [(Id, Id)]
    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 [(Id, Id)]
    goMulti PrimInfo
    p
        Term
    _ -> [(Id, Id)] -> NetlistMonad [(Id, Id)]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
     where
      -- Routine for multi result primitives. For more info:
      -- 'Clash.Normalize.Transformations.setupMultiResultPrim'.
      goMulti :: PrimInfo -> CompiledPrimitive -> NetlistMonad [(Id, Id)]
      goMulti :: PrimInfo -> CompiledPrimitive -> NetlistMonad [(Id, Id)]
    goMulti PrimInfo
    pInfo (BlackBoxHaskell{function :: forall a b c d. Primitive a b c d -> d
    function=(Int
    _, BlackBoxFunction
    function)}) = 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 mpInfo@MultiPrimInfo{mpi_resultTypes} = multiPrimInfo' tcm pInfo
        let (args1, resIds) = splitMultiPrimArgs mpInfo args
        funRes <- preserveVarEnv (function False (primName pInfo) args1 mpi_resultTypes)
        let BlackBoxMeta{bbResultNames} = either error fst funRes
        go (primName pInfo) resIds args1 bbResultNames
      goMulti PrimInfo
    _ CompiledPrimitive
    _ = [(Id, Id)] -> NetlistMonad [(Id, Id)]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []

      -- Routine for single result primitives (the default kind of primitive)
      goSingle :: PrimInfo -> CompiledPrimitive -> NetlistMonad [(Id, Id)]
      goSingle :: PrimInfo -> CompiledPrimitive -> NetlistMonad [(Id, Id)]
    goSingle PrimInfo
    pInfo (BlackBoxHaskell{function :: forall a b c d. Primitive a b c d -> d
    function=(Int
    _, BlackBoxFunction
    function)}) = do
        funRes <- NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
    -> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
    forall a. NetlistMonad a -> NetlistMonad a
    preserveVarEnv (BlackBoxFunction
    function IsVoid
    False (PrimInfo -> Text
    primName PrimInfo
    pInfo) [Either Term Type]
    args [Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf Id
    i])
        case either error fst funRes of
          BlackBoxMeta{bbResultNames :: BlackBoxMeta -> [BlackBox]
    bbResultNames=[BlackBox
    bbResultName]} ->
            Text
    -> [Id]
    -> [Either Term Type]
    -> [BlackBox]
    -> NetlistMonad [(Id, Id)]
    go (PrimInfo -> Text
    primName PrimInfo
    pInfo) [Id
    i] [Either Term Type]
    args [BlackBox
    bbResultName]
          BlackBoxMeta
    _ -> [(Id, Id)] -> NetlistMonad [(Id, Id)]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
      goSingle PrimInfo
    pInfo (BlackBox{resultNames :: forall a b c d. Primitive a b c d -> [b]
    resultNames=[BlackBox
    resultName]}) = do
        Text
    -> [Id]
    -> [Either Term Type]
    -> [BlackBox]
    -> NetlistMonad [(Id, Id)]
    go (PrimInfo -> Text
    primName PrimInfo
    pInfo) [Id
    i] [Either Term Type]
    args [BlackBox
    resultName]
      goSingle PrimInfo
    _ CompiledPrimitive
    _ = [(Id, Id)] -> NetlistMonad [(Id, Id)]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []

      go :: Text -> [Id] -> [Either Term Type] -> [BlackBox] -> NetlistMonad [(Id, Id)]
      go :: Text
    -> [Id]
    -> [Either Term Type]
    -> [BlackBox]
    -> NetlistMonad [(Id, Id)]
    go Text
    nm [Id]
    is0 [Either Term Type]
    bbArgs [BlackBox]
    bbResultTemplates = do
        (bbCtx, _) <- NetlistMonad (BlackBoxContext, [Declaration])
    -> NetlistMonad (BlackBoxContext, [Declaration])
    forall a. NetlistMonad a -> NetlistMonad a
    preserveVarEnv (HasCallStack =>
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    Text
    -> DeclarationType
    -> [Id]
    -> [Either Term Type]
    -> NetlistMonad (BlackBoxContext, [Declaration])
    mkBlackBoxContext Text
    nm DeclarationType
    Concurrent [Id]
    is0 [Either Term Type]
    bbArgs)
        be <- Lens.use backend
        let
          _sameName Var a
    i0 Var a
    i1 = Name a -> Text
    forall a. Name a -> Text
    nameOcc (Var a -> Name a
    forall a. Var a -> Name a
    varName Var a
    i0) Text -> Text -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Name a -> Text
    forall a. Name a -> Text
    nameOcc (Var a -> Name a
    forall a. Var a -> Name a
    varName Var a
    i1)
          newNames = (BlackBox -> Text) -> [BlackBox] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (HasCallStack => SomeBackend -> BlackBoxContext -> BlackBox -> Text
    SomeBackend -> BlackBoxContext -> BlackBox -> Text
    evalBlackBox SomeBackend
    be BlackBoxContext
    bbCtx) [BlackBox]
    bbResultTemplates
          modName Text
    newRetName = (Name a -> Name a) -> Var a -> Var a
    forall a. (Name a -> Name a) -> Var a -> Var a
    modifyVarName (\Name a
    n -> Name a
    n {nameOcc = newRetName})
          is1 = (Text -> Id -> Id) -> [Text] -> [Id] -> [Id]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Text -> Id -> Id
    forall {a}. Text -> Var a -> Var a
    modName [Text]
    newNames [Id]
    is0

        -- TODO: _sameName check disabled due to
        --       https://github.com/clash-lang/clash-compiler/issues/1566
        -- Don't rename if we didn't change any names, it will cause superfluous
        -- redirections in 'mkUniqueNormalized'.
        -- pure (if and (zipWith sameName is0 is1) then [] else zip is0 is1)
        pure (zip is0 is1)

    -- | Render a blackbox given its context. Renders _just_ the blackbox, not any
    -- corresponding includes, libraries, and so forth.
    evalBlackBox :: HasCallStack => SomeBackend -> BlackBoxContext -> BlackBox -> Text
    evalBlackBox :: HasCallStack => SomeBackend -> BlackBoxContext -> BlackBox -> Text
    evalBlackBox (SomeBackend backend
    s) BlackBoxContext
    bbCtx BlackBox
    bb
      | BBFunction [Char]
    _bbName Int
    _bbHash (TemplateFunction [Int]
    _usedArgs BlackBoxContext -> IsVoid
    _verifFunc forall s. Backend s => BlackBoxContext -> State s (Doc ())
    func) <- BlackBox
    bb =
        let layout :: LayoutOptions
    layout = PageWidth -> LayoutOptions
    LayoutOptions (Int -> Double -> PageWidth
    AvailablePerLine Int
    120 Double
    0.4) in
        LazyText -> Text
    toStrict (SimpleDocStream () -> LazyText
    forall ann. SimpleDocStream ann -> LazyText
    renderLazy (LayoutOptions -> Doc () -> SimpleDocStream ()
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
    layoutPretty LayoutOptions
    layout (State backend (Doc ()) -> backend -> Doc ()
    forall s a. State s a -> s -> a
    State.evalState (BlackBoxContext -> State backend (Doc ())
    forall s. Backend s => BlackBoxContext -> State s (Doc ())
    func BlackBoxContext
    bbCtx) backend
    s)))
      | BBTemplate BlackBoxTemplate
    bbt <- BlackBox
    bb =
        LazyText -> Text
    toStrict ((State backend (Int -> LazyText) -> backend -> Int -> LazyText
    forall s a. State s a -> s -> a
    State.evalState (BlackBoxContext
    -> BlackBoxTemplate -> State backend (Int -> LazyText)
    forall backend.
    Backend backend =>
    BlackBoxContext
    -> BlackBoxTemplate -> State backend (Int -> LazyText)
    renderTemplate BlackBoxContext
    bbCtx BlackBoxTemplate
    bbt) backend
    s) Int
    0)

    mkUniqueArguments
      :: Subst
      -> Maybe (ExpandedTopEntity Identifier)
      -- ^ Top entity annotation where:
      --
      --     * Nothing: term is not a top entity
      --     * Just ..: term is a top entity
      -> [Id]
      -> NetlistMonad
           ( [Bool]                 -- Were voids
           , [(Identifier,HWType)]  -- Arguments and their types
           , [Declaration]          -- Extra declarations
           , Subst                  -- Substitution with new vars in scope
           )
    mkUniqueArguments :: Subst
    -> Maybe (ExpandedTopEntity Identifier)
    -> [Id]
    -> NetlistMonad
         ([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
    mkUniqueArguments Subst
    subst0 Maybe (ExpandedTopEntity Identifier)
    Nothing [Id]
    args = do
      (args', subst1) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
    mkUnique Subst
    subst0 [Id]
    args
      ports <- mapM idToInPort args'
      return (map isNothing ports, catMaybes ports, [], subst1)

    mkUniqueArguments Subst
    subst0 (Just (ExpandedTopEntity{[Maybe (ExpandedPortName Identifier)]
    Maybe (ExpandedPortName Identifier)
    et_inputs :: [Maybe (ExpandedPortName Identifier)]
    et_output :: Maybe (ExpandedPortName Identifier)
    et_output :: forall a. ExpandedTopEntity a -> Maybe (ExpandedPortName a)
    et_inputs :: forall a. ExpandedTopEntity a -> [Maybe (ExpandedPortName a)]
    ..})) [Id]
    args = do
      (ports, decls, subst1) <- ([([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
    -> ([[(Identifier, HWType)]], [[Declaration]], [(Id, LetBinding)])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
     -> ([[(Identifier, HWType)]], [[Declaration]], [(Id, LetBinding)]))
    -> ([Maybe
           ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
        -> [([(Identifier, HWType)], [Declaration], (Id, LetBinding))])
    -> [Maybe
          ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
    -> ([[(Identifier, HWType)]], [[Declaration]], [(Id, LetBinding)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
    -> [([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
    forall a. [Maybe a] -> [a]
    catMaybes) ([Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
     -> ([[(Identifier, HWType)]], [[Declaration]], [(Id, LetBinding)]))
    -> NetlistMonad
         [Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [(Id, LetBinding)])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe (ExpandedPortName Identifier)
     -> Id
     -> NetlistMonad
          (Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))))
    -> [Maybe (ExpandedPortName Identifier)]
    -> [Id]
    -> NetlistMonad
         [Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Maybe (ExpandedPortName Identifier)
    -> Id
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
    go [Maybe (ExpandedPortName Identifier)]
    et_inputs [Id]
    args
      return ( map isNothing et_inputs
             , concat ports
             , concat decls
             , extendInScopeIdList (extendIdSubstList subst0 (map snd subst1))
                                   (map fst subst1))
      where
        go :: Maybe (ExpandedPortName Identifier)
    -> Id
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
    go Maybe (ExpandedPortName Identifier)
    Nothing Id
    _var =
          Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
    forall a. Maybe a
    Nothing
        go (Just ExpandedPortName Identifier
    port) Id
    var = do
          (ports, decls, _, portI) <- ExpandedPortName Identifier
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    mkTopInput ExpandedPortName Identifier
    port
          let portName = Identifier -> Text
    Id.toText Identifier
    portI
              pId  = Type -> Name Term -> Id
    mkLocalId (Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf Id
    var) (Text -> Name Term -> Name Term
    forall a. Text -> Name a -> Name a
    setRepName Text
    portName (Id -> Name Term
    forall a. Var a -> Name a
    varName Id
    var))
          return (Just (ports, decls, (pId, (var, Var pId))))

    mkUniqueResult
      :: Subst
      -> Maybe (ExpandedTopEntity Identifier)
      -- ^ Top entity annotation where:
      --
      --     * Nothing: term is not a top entity
      --     * Just ..: term is a top entity
      -> Id
      -> NetlistMonad (Maybe ([(Identifier,HWType)],[Declaration],Id,Subst))
    mkUniqueResult :: Subst
    -> Maybe (ExpandedTopEntity Identifier)
    -> Id
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
    mkUniqueResult Subst
    subst0 Maybe (ExpandedTopEntity Identifier)
    Nothing Id
    res = do
      ([res'],subst1) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
    mkUnique Subst
    subst0 [Id
    res]
      portM <- idToOutPort res'
      case portM of
        Just (Identifier, HWType)
    port -> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (([(Identifier, HWType)], [Declaration], Id, Subst)
    -> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    forall a. a -> Maybe a
    Just ([(Identifier, HWType)
    port],[],Id
    res',Subst
    subst1))
        Maybe (Identifier, HWType)
    _         -> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    forall a. Maybe a
    Nothing

    mkUniqueResult Subst
    _subst0 (Just (ExpandedTopEntity{et_output :: forall a. ExpandedTopEntity a -> Maybe (ExpandedPortName a)
    et_output=Maybe (ExpandedPortName Identifier)
    Nothing})) Id
    _res =
      Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    -> NetlistMonad
         (Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
    forall a. Maybe a
    Nothing
    mkUniqueResult Subst
    subst0 (Just (ExpandedTopEntity{et_output :: forall a. ExpandedTopEntity a -> Maybe (ExpandedPortName a)
    et_output=Just ExpandedPortName Identifier
    iPort})) Id
    res = 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
      (FilteredHWType hwty _) <- unsafeCoreTypeToHWTypeM $(curLoc) (coreTypeOf res)
      when (containsBiSignalIn hwty)
        (throw (ClashException sp ($(curLoc) ++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Nothing))
      (ports, decls, portI) <- mkTopOutput iPort
      let pO = Text -> Name Term -> Name Term
    forall a. Text -> Name a -> Name a
    setRepName (Identifier -> Text
    Id.toText Identifier
    portI) (Id -> Name Term
    forall a. Var a -> Name a
    varName Id
    res)
          pOId = Type -> Name Term -> Id
    mkLocalId (Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf Id
    res) Name Term
    pO
          subst1 = Subst -> Id -> Subst
    extendInScopeId (Subst -> Id -> Term -> Subst
    extendIdSubst Subst
    subst0 Id
    res (Id -> Term
    Var Id
    pOId)) Id
    pOId
      return (Just (ports, decls, pOId, subst1))

    -- | Same as idToPort, but
    --    * Throws an error if the port is a composite type with a BiSignalIn
    idToInPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
    idToInPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
    idToInPort Id
    var = 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
      portM <- idToPort var
      case portM of
        Just (Identifier
    _,HWType
    hty) -> do
          IsVoid -> NetlistMonad () -> NetlistMonad ()
    forall (f :: Type -> Type). Applicative f => IsVoid -> f () -> f ()
    when (HWType -> IsVoid
    containsBiSignalIn HWType
    hty IsVoid -> IsVoid -> IsVoid
    && IsVoid -> IsVoid
    not (HWType -> IsVoid
    isBiSignalIn HWType
    hty))
            (ClashException -> NetlistMonad ()
    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]
    "BiSignalIn currently cannot be part of a composite type when it's a function's argument") Maybe [Char]
    forall a. Maybe a
    Nothing))
          Maybe (Identifier, HWType)
    -> NetlistMonad (Maybe (Identifier, HWType))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe (Identifier, HWType)
    portM
        Maybe (Identifier, HWType)
    _ -> Maybe (Identifier, HWType)
    -> NetlistMonad (Maybe (Identifier, HWType))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe (Identifier, HWType)
    forall a. Maybe a
    Nothing

    -- | Same as idToPort, but:
    --    * Throws an error if port is of type BiSignalIn
    idToOutPort :: Id -> NetlistMonad (Maybe (Identifier,HWType))
    idToOutPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
    idToOutPort Id
    var = do
      (_, srcspan) <- 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
      portM <- idToPort var
      case portM of
        Just (Identifier
    _,HWType
    hty) -> do
          IsVoid -> NetlistMonad () -> NetlistMonad ()
    forall (f :: Type -> Type). Applicative f => IsVoid -> f () -> f ()
    when (HWType -> IsVoid
    containsBiSignalIn HWType
    hty)
            (ClashException -> NetlistMonad ()
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
    ClashException SrcSpan
    srcspan ($(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Maybe [Char]
    forall a. Maybe a
    Nothing))
          Maybe (Identifier, HWType)
    -> NetlistMonad (Maybe (Identifier, HWType))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe (Identifier, HWType)
    portM
        Maybe (Identifier, HWType)
    _ -> Maybe (Identifier, HWType)
    -> NetlistMonad (Maybe (Identifier, HWType))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Maybe (Identifier, HWType)
    forall a. Maybe a
    Nothing

    idToPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
    idToPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
    idToPort Id
    var = do
      hwTy <- [Char] -> Type -> NetlistMonad HWType
    unsafeCoreTypeToHWTypeM' $(curLoc) (Id -> Type
    forall a. HasType a => a -> Type
    coreTypeOf Id
    var)
      if isVoid hwTy
        then return Nothing
        else return (Just (Id.unsafeFromCoreId var, hwTy))

    setRepName :: Text -> Name a -> Name a
    setRepName :: forall a. Text -> Name a -> Name a
    setRepName Text
    s (Name NameSort
    sort' Text
    _ Word64
    i SrcSpan
    loc) = NameSort -> Text -> Word64 -> SrcSpan -> Name a
    forall a. NameSort -> Text -> Word64 -> SrcSpan -> Name a
    Name NameSort
    sort' Text
    s Word64
    i SrcSpan
    loc

    -- | Make a set of IDs unique; also returns a substitution from old ID to new
    -- updated unique ID.
    mkUnique
      :: Subst
      -- ^ Existing substitution
      -> [Id]
      -- ^ IDs to make unique
      -> NetlistMonad ([Id],Subst)
      -- ^ (Unique IDs, update substitution)
    mkUnique :: Subst -> [Id] -> NetlistMonad ([Id], Subst)
    mkUnique = [Id] -> Subst -> [Id] -> NetlistMonad ([Id], Subst)
    go []
      where
        go :: [Id] -> Subst -> [Id] -> NetlistMonad ([Id],Subst)
        go :: [Id] -> Subst -> [Id] -> NetlistMonad ([Id], Subst)
    go [Id]
    processed Subst
    subst []     = ([Id], Subst) -> NetlistMonad ([Id], Subst)
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([Id] -> [Id]
    forall a. [a] -> [a]
    reverse [Id]
    processed,Subst
    subst)
        go [Id]
    processed subst :: Subst
    subst@(Subst InScopeSet
    isN IdSubstEnv
    _ TvSubstEnv
    _ IdSubstEnv
    _) (Id
    i:[Id]
    is) = do
          iN <- Identifier -> Text
    Id.toText (Identifier -> Text)
    -> NetlistMonad Identifier -> NetlistMonad Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Id -> m Identifier
    Id.fromCoreId Id
    i
          let i' = InScopeSet -> Id -> Id
    forall a. (Uniquable a, ClashPretty a) => InScopeSet -> a -> a
    uniqAway InScopeSet
    isN ((Name Term -> Name Term) -> Id -> Id
    forall a. (Name a -> Name a) -> Var a -> Var a
    modifyVarName (Text -> Name Term -> Name Term
    forall a. Text -> Name a -> Name a
    setRepName Text
    iN) Id
    i)
              subst' = Subst -> Id -> Subst
    extendInScopeId (Subst -> Id -> Term -> Subst
    extendIdSubst Subst
    subst Id
    i (Id -> Term
    Var Id
    i')) Id
    i'
          go (i':processed)
             subst'
             is

    -- | Preserve the complete state before running an action, and restore it
    -- afterwards.
    preserveState
      :: NetlistMonad a
      -> NetlistMonad a
    preserveState :: forall a. NetlistMonad a -> NetlistMonad a
    preserveState NetlistMonad a
    action = do
      state <- NetlistMonad NetlistState
    forall s (m :: Type -> Type). MonadState s m => m s
    State.get
      val <- action
      State.put state
      pure val

    -- | Preserve the Netlist '_curCompNm','_seenIds','_usageMap' when executing
    -- a monadic action
    preserveVarEnv
      :: NetlistMonad a
      -> NetlistMonad a
    preserveVarEnv :: forall a. NetlistMonad a -> NetlistMonad a
    preserveVarEnv NetlistMonad a
    action = do
      -- store state
      vComp <- 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
      vSeen <- Lens.use seenIds
      vUses <- Lens.use usageMap
      -- perform action
      val <- action
      -- restore state
      curCompNm .= vComp
      seenIds   .= vSeen
      usageMap  .= vUses
      return val

    dcToLiteral :: HWType -> Int -> Literal
    dcToLiteral :: HWType -> Int -> Literal
    dcToLiteral HWType
    Bool Int
    1 = IsVoid -> Literal
    BoolLit IsVoid
    False
    dcToLiteral HWType
    Bool Int
    2 = IsVoid -> Literal
    BoolLit IsVoid
    True
    dcToLiteral HWType
    _ Int
    i    = Integer -> Literal
    NumLit (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    iInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    1)

    -- * TopEntity Annotations

    extendPorts :: [PortName] -> [Maybe PortName]
    extendPorts :: [PortName] -> [Maybe PortName]
    extendPorts [PortName]
    ps = (PortName -> Maybe PortName) -> [PortName] -> [Maybe PortName]
    forall a b. (a -> b) -> [a] -> [b]
    map PortName -> Maybe PortName
    forall a. a -> Maybe a
    Just [PortName]
    ps [Maybe PortName] -> [Maybe PortName] -> [Maybe PortName]
    forall a. [a] -> [a] -> [a]
    ++ Maybe PortName -> [Maybe PortName]
    forall a. a -> [a]
    repeat Maybe PortName
    forall a. Maybe a
    Nothing

    -- | Prefix given string before portnames /except/ when this string is empty.
    prefixParent :: String -> PortName -> PortName
    prefixParent :: [Char] -> PortName -> PortName
    prefixParent [Char]
    ""     PortName
    p                   = PortName
    p
    prefixParent [Char]
    parent (PortName [Char]
    p)        = [Char] -> PortName
    PortName ([Char]
    parent [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    "_" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    p)
    prefixParent [Char]
    parent (PortProduct [Char]
    "" [PortName]
    ps) = [Char] -> [PortName] -> PortName
    PortProduct [Char]
    parent [PortName]
    ps
    prefixParent [Char]
    parent (PortProduct [Char]
    p [PortName]
    ps)  = [Char] -> [PortName] -> PortName
    PortProduct ([Char]
    parent [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    "_" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    p) [PortName]
    ps

    -- | Make a new signal which is assigned with an initial value. This should be
    -- used in place of NetDecl directly, as it also updates the usage map to
    -- include the new identifier and usage.
    --
    mkInit
      :: HasCallStack
      => DeclarationType
      -- ^ Are we in a concurrent or sequential context?
      -> Usage
      -- ^ How is the initial value assigned if the assignment is separate
      -> Identifier
      -- ^ The identifier of the declared net
      -> HWType
      -- ^ The typr of the declared net
      -> Expr
      -- ^ The value assigned to the net
      -> NetlistMonad [Declaration]
      -- ^ The declarations needed to declare and assign the net
    mkInit :: HasCallStack =>
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    mkInit DeclarationType
    _ Usage
    _ Identifier
    i HWType
    ty Expr
    e
      -- When the initial value is a constant, we can set the value at the same
      -- point the declaration happens. Initial assignments of this form do not
      -- count as a usage as they are always allowed.
      | Expr -> IsVoid
    isConstExpr Expr
    e
      = [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    i HWType
    ty (Expr -> Maybe Expr
    forall a. a -> Maybe a
    Just Expr
    e)]

    mkInit DeclarationType
    Concurrent Usage
    Cont Identifier
    i HWType
    ty Expr
    e = do
      (UsageMap -> Identity UsageMap)
    -> NetlistState -> Identity NetlistState
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' NetlistState UsageMap
    usageMap ((UsageMap -> Identity UsageMap)
     -> NetlistState -> Identity NetlistState)
    -> (UsageMap -> UsageMap) -> NetlistMonad ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= Text -> Usage -> UsageMap -> UsageMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (Identifier -> Text
    Id.toText Identifier
    i) Usage
    Cont
      [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    i HWType
    ty Maybe Expr
    forall a. Maybe a
    Nothing, Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    i Usage
    Cont Expr
    e]

    mkInit DeclarationType
    Concurrent Usage
    proc Identifier
    i HWType
    ty Expr
    e = do
      (UsageMap -> Identity UsageMap)
    -> NetlistState -> Identity NetlistState
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' NetlistState UsageMap
    usageMap ((UsageMap -> Identity UsageMap)
     -> NetlistState -> Identity NetlistState)
    -> (UsageMap -> UsageMap) -> NetlistMonad ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= Text -> Usage -> UsageMap -> UsageMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (Identifier -> Text
    Id.toText Identifier
    i) Usage
    proc
      [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure
        [ Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    i HWType
    ty Maybe Expr
    forall a. Maybe a
    Nothing
        , [Seq] -> Declaration
    Seq [[Seq] -> Seq
    Initial [Declaration -> Seq
    SeqDecl (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    i Usage
    proc Expr
    e)]]
        ]

    mkInit DeclarationType
    Sequential Usage
    Cont Identifier
    _ HWType
    _ Expr
    _ =
      [Char] -> NetlistMonad [Declaration]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "mkInit: Cannot continuously assign in a sequential block"

    mkInit DeclarationType
    Sequential Usage
    proc Identifier
    i HWType
    ty Expr
    e = do
      (UsageMap -> Identity UsageMap)
    -> NetlistState -> Identity NetlistState
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' NetlistState UsageMap
    usageMap ((UsageMap -> Identity UsageMap)
     -> NetlistState -> Identity NetlistState)
    -> (UsageMap -> UsageMap) -> NetlistMonad ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= Text -> Usage -> UsageMap -> UsageMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (Identifier -> Text
    Id.toText Identifier
    i) Usage
    proc
      [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure
        [ Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    i HWType
    ty Maybe Expr
    forall a. Maybe a
    Nothing
        , [Seq] -> Declaration
    Seq [Declaration -> Seq
    SeqDecl (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    i Usage
    proc Expr
    e)]
        ]

    -- | Determine if for the specified HDL, the type of assignment wanted can be
    -- performed on a signal which has been assigned another way. This identifies
    -- when a new intermediary signal needs to be created, e.g.
    --
    --   * when attempting to use blocking and non-blocking procedural assignment
    --     on the same signal in VHDL
    --
    --   * when attempting to use continuous and procedural assignment on the same
    --     signal in (System)Verilog
    --
    canUse :: HDL -> Usage -> Usage -> Bool
    canUse :: HDL -> Usage -> Usage -> IsVoid
    canUse HDL
    VHDL (Proc Blocking
    Blocking) = \case
      Proc Blocking
    Blocking -> IsVoid
    True
      Usage
    _ -> IsVoid
    False

    canUse HDL
    VHDL Usage
    _ = \case
      Proc Blocking
    Blocking -> IsVoid
    False
      Usage
    _ -> IsVoid
    True

    canUse HDL
    _ Usage
    Cont = \case
      Usage
    Cont -> IsVoid
    True
      Usage
    _ -> IsVoid
    False

    canUse HDL
    _ Usage
    _ = \case
      Usage
    Cont -> IsVoid
    False
      Usage
    _ -> IsVoid
    True

    declareUse :: Usage -> Identifier -> NetlistMonad ()
    declareUse :: Usage -> Identifier -> NetlistMonad ()
    declareUse Usage
    u Identifier
    i = (UsageMap -> Identity UsageMap)
    -> NetlistState -> Identity NetlistState
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' NetlistState UsageMap
    usageMap ((UsageMap -> Identity UsageMap)
     -> NetlistState -> Identity NetlistState)
    -> (UsageMap -> UsageMap) -> NetlistMonad ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= (Usage -> Usage -> Usage) -> Text -> Usage -> UsageMap -> UsageMap
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith Usage -> Usage -> Usage
    forall a. Semigroup a => a -> a -> a
    (<>) (Identifier -> Text
    Id.toText Identifier
    i) Usage
    u

    -- | Like 'declareUse', but will throw an exception if we run into a name
    -- collision.
    declareUseOnce :: HasUsageMap s => Usage -> Identifier -> State.State s ()
    declareUseOnce :: forall s. HasUsageMap s => Usage -> Identifier -> State s ()
    declareUseOnce Usage
    u Identifier
    i = (UsageMap -> Identity UsageMap) -> s -> Identity s
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' s UsageMap
    usageMap ((UsageMap -> Identity UsageMap) -> s -> Identity s)
    -> (UsageMap -> UsageMap) -> StateT s Identity ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= (Maybe Usage -> Maybe Usage) -> Text -> UsageMap -> UsageMap
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter Maybe Usage -> Maybe Usage
    forall {a}. Maybe a -> Maybe Usage
    go (Identifier -> Text
    Id.toText Identifier
    i)
     where
      go :: Maybe a -> Maybe Usage
    go Maybe a
    Nothing = Usage -> Maybe Usage
    forall a. a -> Maybe a
    Just Usage
    u
      go Just{}  = [Char] -> Maybe Usage
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Internal error: unexpected re-declaration of usage for" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Identifier -> [Char]
    forall a. Show a => a -> [Char]
    show Identifier
    i)

    -- | Declare uses which occur as a result of a component being instantiated,
    -- for example the following design (verilog)
    --
    -- > module f ( input p; output reg r ) ... endmodule
    -- >
    -- > module top ( ... )
    -- >   ...
    -- >   f f_inst ( .p(p), .r(foo));
    -- >   ...
    -- > endmodule
    --
    -- would declare a usage of foo, since it is assigned by @f_inst@.
    --
    declareInstUses
      :: [(Expr, PortDirection, HWType, Expr)]
      -- ^ The port mappings (named)
      -> NetlistMonad ()
    declareInstUses :: [(Expr, PortDirection, HWType, Expr)] -> NetlistMonad ()
    declareInstUses =
      ((Expr, PortDirection, HWType, Expr) -> NetlistMonad ())
    -> [(Expr, PortDirection, HWType, Expr)] -> NetlistMonad ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Expr, PortDirection, HWType, Expr) -> NetlistMonad ()
    forall {c}.
    Show c =>
    (Expr, PortDirection, c, Expr) -> NetlistMonad ()
    declare
     where
      -- Modifiers don't matter for these identifiers
      declare :: (Expr, PortDirection, c, Expr) -> NetlistMonad ()
    declare (Identifier Identifier
    _ Maybe Modifier
    _, PortDirection
    Out, c
    _, Identifier Identifier
    n Maybe Modifier
    _) =
        -- See NOTE [output ports are continuously assigned]
        Usage -> Identifier -> NetlistMonad ()
    declareUse Usage
    Cont Identifier
    n

      declare (Expr
    _, PortDirection
    In, c
    _, Expr
    _) =
        () -> NetlistMonad ()
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ()

      declare (Expr, PortDirection, c, Expr)
    portMapping =
        [Char] -> NetlistMonad ()
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "declareInstUses: Unexpected port mapping: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> (Expr, PortDirection, c, Expr) -> [Char]
    forall a. Show a => a -> [Char]
    show (Expr, PortDirection, c, Expr)
    portMapping)

    {-
    NOTE [output ports are continuously assigned]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When a module is instantiated in Verilog, the output of the module is always
    continuously assigned. This means if I have the module

      module f ( ..., output reg result)

    and an instantiation

      f f_inst ( ..., .result(foo) );

    then the assignment of result to foo is a continuous assignment. This may seem
    strange, but consider

      * instantiations can only occur in a concurrent context, and concurrent
        contexts only admit continuous assignment

      * the usage being tracked is not for the result port, but for foo. Whenever
        the value of the port changes, the value of foo will change (i.e. there is
        a wire between them, it cannot "hold" state).

    This means when we declare uses that occur as a result of an instantiation in
    netlist, the uses are always continuous assignment, and not the usage of the
    output port as given in the `outputs` field of the `Component` type.
    -}

    assignmentWith
      :: HasCallStack
      => (Identifier -> Declaration)
      -> Usage
      -> Identifier
      -> NetlistMonad Declaration
    assignmentWith :: HasCallStack =>
    (Identifier -> Declaration)
    -> Usage -> Identifier -> NetlistMonad Declaration
    assignmentWith Identifier -> Declaration
    assign Usage
    new Identifier
    i = do
      u <- Getting UsageMap NetlistState UsageMap -> NetlistMonad UsageMap
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting UsageMap NetlistState UsageMap
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' NetlistState UsageMap
    usageMap
      SomeBackend b <- Lens.use backend

      case lookupUsage i u of
        Just Usage
    old | IsVoid -> IsVoid
    not (IsVoid -> IsVoid) -> IsVoid -> IsVoid
    forall a b. (a -> b) -> a -> b
    $ HDL -> Usage -> Usage -> IsVoid
    canUse (backend -> HDL
    forall state. Backend state => state -> HDL
    hdlKind backend
    b) Usage
    new Usage
    old ->
          [Char] -> NetlistMonad Declaration
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> NetlistMonad Declaration)
    -> [Char] -> NetlistMonad Declaration
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall a. Monoid a => [a] -> a
    mconcat
            [ [Char]
    "assignmentWith: Cannot assign as "
            , Usage -> [Char]
    forall a. Show a => a -> [Char]
    show Usage
    new
            , [Char]
    " after "
            , Usage -> [Char]
    forall a. Show a => a -> [Char]
    show Usage
    old
            , [Char]
    " for "
            , Identifier -> [Char]
    forall a. Show a => a -> [Char]
    show Identifier
    i
            ]

        Maybe Usage
    _ ->
          Usage -> Identifier -> NetlistMonad ()
    declareUse Usage
    new Identifier
    i NetlistMonad () -> Declaration -> NetlistMonad Declaration
    forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
    $> Identifier -> Declaration
    assign Identifier
    i

    -- | Attempt to continuously assign an expression to the given identifier. If
    -- the assignment is not allowed for the backend being used, a new signal is
    -- created which allows the assignment. The identifier which holds the result
    -- of the assignment is returned alongside the new declarations.
    --
    -- This function assumes the identifier being assigned is already declared. If
    -- the identifier is not in the usage map then an error is thrown.
    --
    contAssign
      :: HasCallStack
      => Identifier
      -> Expr
      -> NetlistMonad Declaration
    contAssign :: HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    dst Expr
    expr =
      HasCallStack =>
    (Identifier -> Declaration)
    -> Usage -> Identifier -> NetlistMonad Declaration
    (Identifier -> Declaration)
    -> Usage -> Identifier -> NetlistMonad Declaration
    assignmentWith (\Identifier
    i -> Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    i Usage
    Cont Expr
    expr) Usage
    Cont Identifier
    dst

    procAssign
      :: HasCallStack
      => Blocking
      -> Identifier
      -> Expr
      -> NetlistMonad Declaration
    procAssign :: HasCallStack =>
    Blocking -> Identifier -> Expr -> NetlistMonad Declaration
    procAssign Blocking
    block Identifier
    dst Expr
    expr =
      HasCallStack =>
    (Identifier -> Declaration)
    -> Usage -> Identifier -> NetlistMonad Declaration
    (Identifier -> Declaration)
    -> Usage -> Identifier -> NetlistMonad Declaration
    assignmentWith (\Identifier
    i -> Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    i (Blocking -> Usage
    Proc Blocking
    block) Expr
    expr) (Blocking -> Usage
    Proc Blocking
    block) Identifier
    dst

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

    -- | See 'toPrimitiveType' / 'fromPrimitiveType'
    convPrimitiveType :: HWType -> a -> NetlistMonad a -> NetlistMonad a
    convPrimitiveType :: forall a. HWType -> a -> NetlistMonad a -> NetlistMonad a
    convPrimitiveType HWType
    hwty a
    a NetlistMonad a
    action = do
      b <- Getting SomeBackend NetlistState SomeBackend
    -> NetlistMonad SomeBackend
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting SomeBackend NetlistState SomeBackend
    Lens' NetlistState SomeBackend
    backend
      let kind = case SomeBackend
    b of {SomeBackend backend
    s -> State backend HWKind -> backend -> HWKind
    forall s a. State s a -> s -> a
    State.evalState (HWType -> State backend HWKind
    forall state. Backend state => HWType -> State state HWKind
    hdlHWTypeKind HWType
    hwty) backend
    s}
      case kind of
        HWKind
    UserType -> NetlistMonad a
    action
        HWKind
    SynonymType -> a -> NetlistMonad a
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure a
    a
        HWKind
    PrimitiveType -> a -> NetlistMonad a
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure a
    a

    -- | Top entities only expose primitive types or types that don't need explicit
    -- conversion to a primitive type (i.e., no types from the '_types' module). This
    -- function converts from a custom type to a primitive type if needed.
    --
    -- See 'HWKind' for more info on primitive type kinds.
    toPrimitiveType
      :: Identifier
      -> HWType
      -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    toPrimitiveType :: Identifier
    -> HWType -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    toPrimitiveType Identifier
    id0 HWType
    hwty0 = HWType
    -> ([Declaration], Identifier, Expr, HWType)
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    forall a. HWType -> a -> NetlistMonad a -> NetlistMonad a
    convPrimitiveType HWType
    hwty0 ([Declaration], Identifier, Expr, HWType)
    forall {a}. ([a], Identifier, Expr, HWType)
    dflt (NetlistMonad ([Declaration], Identifier, Expr, HWType)
     -> NetlistMonad ([Declaration], Identifier, Expr, HWType))
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    forall a b. (a -> b) -> a -> b
    $ do
      id1 <- Identifier -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    id0
      ds  <- mkInit Concurrent Cont id1 hwty1 expr
      pure (ds, id1, expr, hwty1)
     where
      dflt :: ([a], Identifier, Expr, HWType)
    dflt = ([], Identifier
    id0, Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id0 Maybe Modifier
    forall a. Maybe a
    Nothing, HWType
    hwty0)
      hwty1 :: HWType
    hwty1 = Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty0)
      expr :: Expr
    expr = Maybe Identifier -> HWType -> Expr -> Expr
    ToBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    hwty0 (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id0 Maybe Modifier
    forall a. Maybe a
    Nothing)

    -- | Top entities only expose primitive types or types that don't need explicit
    -- conversion to a primitive type (i.e., no types from the '_types' module). This
    -- function converts from a primitive type to a custom type if needed.
    --
    -- See 'HWKind' for more info on primitive type kinds.
    fromPrimitiveType
      :: Identifier
      -> HWType
      -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    fromPrimitiveType :: Identifier
    -> HWType -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    fromPrimitiveType Identifier
    id0 HWType
    hwty0 = HWType
    -> ([Declaration], Identifier, Expr, HWType)
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    forall a. HWType -> a -> NetlistMonad a -> NetlistMonad a
    convPrimitiveType HWType
    hwty0 ([Declaration], Identifier, Expr, HWType)
    forall {a}. ([a], Identifier, Expr, HWType)
    dflt (NetlistMonad ([Declaration], Identifier, Expr, HWType)
     -> NetlistMonad ([Declaration], Identifier, Expr, HWType))
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    forall a b. (a -> b) -> a -> b
    $ do
      id1 <- Identifier -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    id0
      ds <- mkInit Concurrent Cont id1 hwty0 expr
      pure (ds, id1, expr, hwty1)
     where
      dflt :: ([a], Identifier, Expr, HWType)
    dflt = ([], Identifier
    id0, Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id0 Maybe Modifier
    forall a. Maybe a
    Nothing, HWType
    hwty0)
      hwty1 :: HWType
    hwty1 = Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty0)
      expr :: Expr
    expr = Maybe Identifier -> HWType -> Expr -> Expr
    FromBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    hwty0 (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id0 Maybe Modifier
    forall a. Maybe a
    Nothing)

    -- | Create port names for the declaration of a top entity. For /instantiation/
    -- see 'mkTopInstInput'.
    mkTopInput
      :: ExpandedPortName Identifier
      -- ^ Port name description
      -> NetlistMonad ([(Identifier, HWType)], [Declaration], Expr, Identifier)
      -- ^ (port names, signal decls for intermediate signals, argument expr, argument id)
    mkTopInput :: ExpandedPortName Identifier
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    mkTopInput (ExpandedPortName HWType
    hwty0 Identifier
    i0) = do
      (decls, i1, expr, hwty1) <- Identifier
    -> HWType -> NetlistMonad ([Declaration], Identifier, Expr, HWType)
    fromPrimitiveType Identifier
    i0 HWType
    hwty0
      return ([(i0, hwty1)], decls, expr, i1)

    mkTopInput epp :: ExpandedPortName Identifier
    epp@(ExpandedPortProduct Text
    p HWType
    hwty [ExpandedPortName Identifier]
    ps) = do
      pN <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    p
      case hwty of
        Vector Int
    sz HWType
    eHwty -> do
          (ports, _, exprs, _) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
        [Identifier])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
         [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Expr, Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    mkTopInput [ExpandedPortName Identifier]
    ps
          let vecExpr  = Int -> HWType -> [Expr] -> Expr
    mkVectorChain Int
    sz HWType
    eHwty [Expr]
    exprs
          decls <- mkInit Concurrent Cont pN hwty vecExpr
          return (concat ports, decls, vecExpr, pN)

        RTree Int
    d HWType
    eHwty -> do
          (ports, _, exprs, _) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
        [Identifier])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
         [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Expr, Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    mkTopInput [ExpandedPortName Identifier]
    ps
          let trExpr   = Int -> HWType -> [Expr] -> Expr
    mkRTreeChain Int
    d HWType
    eHwty [Expr]
    exprs
          decls <- mkInit Concurrent Cont pN hwty trExpr
          return (concat ports, decls, trExpr, pN)

        Product Text
    _ Maybe [Text]
    _ [HWType]
    _ -> do
          (ports, _, exprs, _) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
        [Identifier])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
         [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Expr, Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    mkTopInput [ExpandedPortName Identifier]
    ps
          case exprs of
            [Expr
    expr] -> do
              decls <- HasCallStack =>
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    mkInit DeclarationType
    Concurrent Usage
    Cont Identifier
    pN HWType
    hwty Expr
    expr
              return (concat ports, decls, expr, pN)
            [Expr]
    _ -> do
              let dcExpr :: Expr
    dcExpr = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    hwty ((HWType, Int) -> Modifier
    DC (HWType
    hwty, Int
    0)) [Expr]
    exprs
              decls <- HasCallStack =>
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    mkInit DeclarationType
    Concurrent Usage
    Cont Identifier
    pN HWType
    hwty Expr
    dcExpr
              return (concat ports, decls, dcExpr, pN)

        SP Text
    _ (([[HWType]] -> [HWType]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[HWType]] -> [HWType])
    -> ([(Text, [HWType])] -> [[HWType]])
    -> [(Text, [HWType])]
    -> [HWType]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [[HWType]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) -> [HWType
    elTy]) -> do
          (ports, _, exprs, _) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
        [Identifier])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
         [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Expr, Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    mkTopInput [ExpandedPortName Identifier]
    ps
          case exprs of
            [Expr
    conExpr, Expr
    elExpr] -> do
              let dcExpr :: Expr
    dcExpr   = HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    hwty ((HWType, Int) -> Modifier
    DC (Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty), Int
    0))
                              [Expr
    conExpr, Maybe Identifier -> HWType -> Expr -> Expr
    ToBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    elTy Expr
    elExpr]
              decls <- HasCallStack =>
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    DeclarationType
    -> Usage
    -> Identifier
    -> HWType
    -> Expr
    -> NetlistMonad [Declaration]
    mkInit DeclarationType
    Concurrent Usage
    Cont Identifier
    pN HWType
    hwty Expr
    dcExpr
              return (concat ports, decls, dcExpr, pN)
            [Expr]
    _ -> [Char]
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Expr, Identifier))
    -> [Char]
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Internal error"

        HWType
    _ ->
          -- 'expandTopEntity' should have made sure this isn't possible
          [Char]
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Expr, Identifier))
    -> [Char]
    -> NetlistMonad
         ([(Identifier, HWType)], [Declaration], Expr, Identifier)
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Internal error: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ExpandedPortName Identifier -> [Char]
    forall a. Show a => a -> [Char]
    show ExpandedPortName Identifier
    epp

    portProductError :: String -> HWType -> ExpandedPortName Identifier -> a
    portProductError :: forall a. [Char] -> HWType -> ExpandedPortName Identifier -> a
    portProductError [Char]
    loc HWType
    hwty ExpandedPortName Identifier
    portProduct = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> a) -> [Char] -> a
    forall a b. (a -> b) -> a -> b
    $ [Char]
    loc [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [I.i|
      #{loc}PortProduct used, but did not see Vector, RTree, or Product. Saw the
      following instead:

        #{hwty}

      PortProduct used:

        #{portProduct}

      Note that the PortProduct as shown above might is only indicative, and might
      not correspond exactly to the one given in the Clash design. |]

    -- | Create a Vector chain for a list of 'Identifier's
    mkVectorChain :: Int
                  -> HWType
                  -> [Expr]
                  -> Expr
    mkVectorChain :: Int -> HWType -> [Expr] -> Expr
    mkVectorChain Int
    _ HWType
    elTy []      = HWType -> Modifier -> [Expr] -> Expr
    DataCon (Int -> HWType -> HWType
    Vector Int
    0 HWType
    elTy) Modifier
    VecAppend []
    mkVectorChain Int
    _ HWType
    elTy [Expr
    e]     = HWType -> Modifier -> [Expr] -> Expr
    DataCon (Int -> HWType -> HWType
    Vector Int
    1 HWType
    elTy) Modifier
    VecAppend
                                    [Expr
    e]
    mkVectorChain Int
    sz HWType
    elTy (Expr
    e:[Expr]
    es) = HWType -> Modifier -> [Expr] -> Expr
    DataCon (Int -> HWType -> HWType
    Vector Int
    sz HWType
    elTy) Modifier
    VecAppend
                                    [ Expr
    e
                                    , Int -> HWType -> [Expr] -> Expr
    mkVectorChain (Int
    szInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) HWType
    elTy [Expr]
    es
                                    ]

    -- | Create a RTree chain for a list of 'Identifier's
    mkRTreeChain :: Int
                 -> HWType
                 -> [Expr]
                 -> Expr
    mkRTreeChain :: Int -> HWType -> [Expr] -> Expr
    mkRTreeChain Int
    _ HWType
    elTy [Expr
    e] = HWType -> Modifier -> [Expr] -> Expr
    DataCon (Int -> HWType -> HWType
    RTree Int
    0 HWType
    elTy) Modifier
    RTreeAppend
                                      [Expr
    e]
    mkRTreeChain Int
    d HWType
    elTy [Expr]
    es =
      let ([Expr]
    esL,[Expr]
    esR) = Int -> [Expr] -> ([Expr], [Expr])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([Expr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [Expr]
    es Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) [Expr]
    es
      in  HWType -> Modifier -> [Expr] -> Expr
    DataCon (Int -> HWType -> HWType
    RTree Int
    d HWType
    elTy) Modifier
    RTreeAppend
            [ Int -> HWType -> [Expr] -> Expr
    mkRTreeChain (Int
    dInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) HWType
    elTy [Expr]
    esL
            , Int -> HWType -> [Expr] -> Expr
    mkRTreeChain (Int
    dInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) HWType
    elTy [Expr]
    esR
            ]

    genComponentName
      :: Bool
      -- ^ New inline strategy enabled
      -> Maybe Text
      -- ^ Component name prefix
      -> Id
      -- ^ Create component name based on this Core Id
      -> Text
    genComponentName :: IsVoid -> Maybe Text -> Id -> Text
    genComponentName IsVoid
    newInlineStrat Maybe Text
    prefixM Id
    nm =
      Text -> [Text] -> Text
    Text.intercalate Text
    "_" ([Text]
    prefix [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text
    fn1])
     where
      nm0 :: [Text]
    nm0 = HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    Text.splitOn Text
    "." (Name Term -> Text
    forall a. Name a -> Text
    nameOcc (Id -> Name Term
    forall a. Var a -> Name a
    varName Id
    nm))
      fn0 :: Text
    fn0 = Text -> Text
    Id.stripDollarPrefixes ([Text] -> Text
    forall a. HasCallStack => [a] -> a
    last [Text]
    nm0)
      fn1 :: Text
    fn1 = if Text -> IsVoid
    Text.null Text
    fn0 then Text
    "Component" else Text
    fn0
      prefix :: [Text]
    prefix = [Text] -> Maybe [Text] -> [Text]
    forall a. a -> Maybe a -> a
    fromMaybe (if IsVoid
    newInlineStrat then [] else [Text] -> [Text]
    forall a. HasCallStack => [a] -> [a]
    init [Text]
    nm0) (Text -> [Text]
    forall a. a -> [a]
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Text -> [Text]) -> Maybe Text -> Maybe [Text]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Text
    prefixM)

    genTopName
      :: IdentifierSetMonad m
      => Maybe Text
      -- ^ Top entity name prefix
      -> TopEntity
      -- ^ Top entity annotation
      -> m Identifier
      -- ^ New identifier
    genTopName :: forall (m :: Type -> Type).
    IdentifierSetMonad m =>
    Maybe Text -> TopEntity -> m Identifier
    genTopName Maybe Text
    prefixM TopEntity
    ann =
      case Maybe Text
    prefixM of
        Just Text
    prefix | IsVoid -> IsVoid
    not (Text -> IsVoid
    Text.null Text
    prefix) ->
          Text -> m Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.addRaw ([Text] -> Text
    Text.concat [Text
    prefix, Text
    "_", [Char] -> Text
    Text.pack (TopEntity -> [Char]
    t_name TopEntity
    ann)])
        Maybe Text
    _ ->
          Text -> m Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.addRaw ([Char] -> Text
    Text.pack (TopEntity -> [Char]
    t_name TopEntity
    ann))

    -- | Strips one or more layers of attributes from a HWType; stops at first
    -- non-Annotated. Accumulates all attributes of nested annotations.
    stripAttributes
      :: HWType
      -> ([Attr Text], HWType)
    -- Recursively strip type, accumulate attrs:
    stripAttributes :: HWType -> ([Attr Text], HWType)
    stripAttributes (Annotated [Attr Text]
    attrs HWType
    typ) =
      let ([Attr Text]
    attrs', HWType
    typ') = HWType -> ([Attr Text], HWType)
    stripAttributes HWType
    typ
      in ([Attr Text]
    attrs [Attr Text] -> [Attr Text] -> [Attr Text]
    forall a. [a] -> [a] -> [a]
    ++ [Attr Text]
    attrs', HWType
    typ')
    -- Not an annotated type, so just return it:
    stripAttributes HWType
    typ = ([], HWType
    typ)

    -- | Create output port names for the declaration of a top entity. For
    -- /instantiation/ see 'mkTopInstOutput'.
    mkTopOutput
      :: ExpandedPortName Identifier
      -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    mkTopOutput :: ExpandedPortName Identifier
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    mkTopOutput (ExpandedPortName HWType
    hwty0 Identifier
    i0) = do
      i1 <- Identifier -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    i0
      (_, _, bvExpr, hwty1) <- toPrimitiveType i1 hwty0
      if hwty0 == hwty1 then
        -- No type conversion happened, so we can just request caller to assign to
        -- port name directly.
        return ([(i0, hwty0)], [], i0)
      else do
        -- Type conversion happened, so we must use intermediate variable.
        assn <- contAssign i0 bvExpr
        pure ( [(i0, hwty1)], [NetDecl' Nothing i1 hwty0 Nothing, assn], i1)

    mkTopOutput epp :: ExpandedPortName Identifier
    epp@(ExpandedPortProduct Text
    p HWType
    hwty [ExpandedPortName Identifier]
    ps) = do
      pN <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    p
      let netdecl = Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    pN HWType
    hwty Maybe Expr
    forall a. Maybe a
    Nothing
      case hwty of
        Vector {} -> do
          (ports, decls, ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    mkTopOutput [ExpandedPortName Identifier]
    ps
          assigns <- zipWithM (\Identifier
    i Int
    n -> Identifier
    -> HWType -> Int -> Identifier -> Int -> NetlistMonad Declaration
    assignId Identifier
    pN HWType
    hwty Int
    10 Identifier
    i Int
    n) ids [0..]
          return (concat ports, netdecl : assigns ++ concat decls, pN)

        RTree {} -> do
          (ports, decls, ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    mkTopOutput [ExpandedPortName Identifier]
    ps
          assigns <- zipWithM (\Identifier
    i Int
    n -> Identifier
    -> HWType -> Int -> Identifier -> Int -> NetlistMonad Declaration
    assignId Identifier
    pN HWType
    hwty Int
    10 Identifier
    i Int
    n) ids [0..]
          return (concat ports, netdecl : assigns ++ concat decls, pN)

        Product {} -> do
          (ports, decls, ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    mkTopOutput [ExpandedPortName Identifier]
    ps
          case ids of
            [Identifier
    i] -> do
              assn <- HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    i (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    pN Maybe Modifier
    forall a. Maybe a
    Nothing)
              pure (concat ports, netdecl : assn : concat decls, pN)

            [Identifier]
    _   -> do
              assigns <- (Identifier -> Int -> NetlistMonad Declaration)
    -> [Identifier] -> [Int] -> NetlistMonad [Declaration]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (\Identifier
    i Int
    n -> Identifier
    -> HWType -> Int -> Identifier -> Int -> NetlistMonad Declaration
    assignId Identifier
    pN HWType
    hwty Int
    0 Identifier
    i Int
    n) [Identifier]
    ids [Int
    0..]
              pure (concat ports, netdecl : assigns ++ concat decls, pN)

        SP Text
    _ (([[HWType]] -> [HWType]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[HWType]] -> [HWType])
    -> ([(Text, [HWType])] -> [[HWType]])
    -> [(Text, [HWType])]
    -> [HWType]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [[HWType]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) -> [HWType
    elTy]) -> do
          (ports, decls, ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
    -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
     -> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    -> NetlistMonad
         ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad
         [([(Identifier, HWType)], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    mkTopOutput [ExpandedPortName Identifier]
    ps
          case ids of
            [Identifier
    conId, Identifier
    elId] -> do
              let conIx :: Modifier
    conIx   = (HWType, Int, Int) -> Modifier
    Sliced ( Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty)
                                   , HWType -> Int
    typeSize HWType
    hwty Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                                   , HWType -> Int
    typeSize HWType
    elTy )
                  elIx :: Modifier
    elIx    = (HWType, Int, Int) -> Modifier
    Sliced ( Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty)
                                   , HWType -> Int
    typeSize HWType
    elTy Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                                   , Int
    0 )

              conAssgn <- HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    conId (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    pN (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just Modifier
    conIx))
              elAssgn <- contAssign elId (FromBv Nothing elTy (Identifier pN (Just elIx)))

              pure (concat ports, netdecl:conAssgn:elAssgn:concat decls, pN)
            [Identifier]
    _ -> [Char]
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Identifier))
    -> [Char]
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Internal error"
        -- 'expandTopEntity' should have made sure this isn't possible
        HWType
    _ -> [Char]
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
     -> NetlistMonad
          ([(Identifier, HWType)], [Declaration], Identifier))
    -> [Char]
    -> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
    forall a b. (a -> b) -> a -> b
    $ $(curLoc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Internal error: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ExpandedPortName Identifier -> [Char]
    forall a. Show a => a -> [Char]
    show ExpandedPortName Identifier
    epp

     where
      assignId :: Identifier
    -> HWType -> Int -> Identifier -> Int -> NetlistMonad Declaration
    assignId Identifier
    p_ HWType
    hwty_ Int
    con Identifier
    i Int
    n =
        HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    i (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    p_ (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (HWType
    hwty_, Int
    con, Int
    n))))

    mkTopCompDecl
      :: Maybe Text
      -- ^ Library entity is defined in
      -> [Attr Text]
      -- ^ Attributes to add to generate code
      -> Identifier
      -- ^ The component's (or entity's) name
      -> Identifier
      -- ^ Instance label
      -> [(Expr, HWType, Expr)]
      -- ^ List of parameters for this component (param name, param type, param value)
      -> [InstancePort]
      -- ^ Input port assignments
      -> [InstancePort]
      -- ^ Output port assignments
      -> Declaration
    mkTopCompDecl :: Maybe Text
    -> [Attr Text]
    -> Identifier
    -> Identifier
    -> [(Expr, HWType, Expr)]
    -> [InstancePort]
    -> [InstancePort]
    -> Declaration
    mkTopCompDecl Maybe Text
    lib [Attr Text]
    attrs Identifier
    name Identifier
    instName [(Expr, HWType, Expr)]
    params [InstancePort]
    inputs [InstancePort]
    outputs =
      EntityOrComponent
    -> Maybe Text
    -> [Attr Text]
    -> Identifier
    -> Identifier
    -> [(Expr, HWType, Expr)]
    -> PortMap
    -> Declaration
    InstDecl EntityOrComponent
    Entity Maybe Text
    lib [Attr Text]
    attrs Identifier
    name Identifier
    instName [(Expr, HWType, Expr)]
    params ([(PortDirection, HWType, Expr)] -> PortMap
    IndexedPortMap [(PortDirection, HWType, Expr)]
    ports)
     where
      ports :: [(PortDirection, HWType, Expr)]
    ports = (InstancePort -> (PortDirection, HWType, Expr))
    -> [InstancePort] -> [(PortDirection, HWType, Expr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (PortDirection -> InstancePort -> (PortDirection, HWType, Expr)
    forall {a}. a -> InstancePort -> (a, HWType, Expr)
    toPort PortDirection
    In) [InstancePort]
    inputs [(PortDirection, HWType, Expr)]
    -> [(PortDirection, HWType, Expr)]
    -> [(PortDirection, HWType, Expr)]
    forall a. [a] -> [a] -> [a]
    ++ (InstancePort -> (PortDirection, HWType, Expr))
    -> [InstancePort] -> [(PortDirection, HWType, Expr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (PortDirection -> InstancePort -> (PortDirection, HWType, Expr)
    forall {a}. a -> InstancePort -> (a, HWType, Expr)
    toPort PortDirection
    Out) [InstancePort]
    outputs
      toExpr :: Identifier -> Expr
    toExpr Identifier
    id_ = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id_ Maybe Modifier
    forall a. Maybe a
    Nothing
      toPort :: a -> InstancePort -> (a, HWType, Expr)
    toPort a
    dir InstancePort
    ip = (a
    dir, (InstancePort -> HWType
    ip_type InstancePort
    ip), Identifier -> Expr
    toExpr (InstancePort -> Identifier
    ip_id InstancePort
    ip))

    -- | Instantiate a TopEntity, and add the proper type-conversions where needed
    mkTopUnWrapper
      :: Id
      -- ^ Name of the TopEntity component
      -> ExpandedTopEntity Identifier
      -- ^ A corresponding @TopEntity@ annotation
      -> (Identifier, HWType)
      -- ^ The name and type of the signal to which to assign the result
      -> [(Expr,HWType)]
      -- ^ The arguments with voids filtered.
      -> [Declaration]
      -- ^ Tick declarations
      -> NetlistMonad [Declaration]
    mkTopUnWrapper :: Id
    -> ExpandedTopEntity Identifier
    -> (Identifier, HWType)
    -> [(Expr, HWType)]
    -> [Declaration]
    -> NetlistMonad [Declaration]
    mkTopUnWrapper Id
    topEntity ExpandedTopEntity Identifier
    annM (Identifier, HWType)
    dstId [(Expr, HWType)]
    args [Declaration]
    tickDecls = do
      -- component name
      compNameM <- Id -> VarEnv Identifier -> Maybe Identifier
    forall b a. Var b -> VarEnv a -> Maybe a
    lookupVarEnv Id
    topEntity (VarEnv Identifier -> Maybe Identifier)
    -> NetlistMonad (VarEnv Identifier)
    -> NetlistMonad (Maybe Identifier)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Getting (VarEnv Identifier) NetlistState (VarEnv Identifier)
    -> NetlistMonad (VarEnv Identifier)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    Lens.use Getting (VarEnv Identifier) NetlistState (VarEnv Identifier)
    Lens' NetlistState (VarEnv Identifier)
    componentNames
      let
        topName = Identifier -> Text
    Id.toText Identifier
    topIdentifier
        topIdentifier = (Identifier -> Maybe Identifier -> Identifier)
    -> Maybe Identifier -> Identifier -> Identifier
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Identifier -> Maybe Identifier -> Identifier
    forall a. a -> Maybe a -> a
    fromMaybe Maybe Identifier
    compNameM ([Char] -> Identifier
    forall a. HasCallStack => [Char] -> a
    error [I.i|
         Internal error in 'mkTopUnWrapper': tried to lookup (netlist) name
         of #{showPpr (varName topEntity)}, but couldn't find it in NetlistState's
         'componentNames'. This should have been put there by 'runNetlistMonad' /
         'genNames'. |])

      -- inputs
      (iports, wrappers, idsI) <- unzip3 <$> mapM mkTopInstInput (catMaybes (et_inputs annM))
      inpAssigns <- zipWithM (\Identifier
    i Expr
    e -> HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    i Expr
    e) idsI (fst <$> args)

      -- output
      let
        iResult = [Declaration]
    inpAssigns [Declaration] -> [[Declaration]] -> [[Declaration]]
    forall a. a -> [a] -> [a]
    : [[Declaration]]
    wrappers
        instLabel0 = [Text] -> Text
    Text.concat [Text
    topName, Text
    "_", Identifier -> Text
    Id.toText ((Identifier, HWType) -> Identifier
    forall a b. (a, b) -> a
    fst (Identifier, HWType)
    dstId)]

      instLabel1 <- fromMaybe instLabel0 <$> Lens.view setName
      instLabel2 <- affixName instLabel1
      instLabel3 <- Id.makeBasic instLabel2
      topOutputM <- traverse mkTopInstOutput (et_output annM)

      let topDecl = Maybe Text
    -> [Attr Text]
    -> Identifier
    -> Identifier
    -> [(Expr, HWType, Expr)]
    -> [InstancePort]
    -> [InstancePort]
    -> Declaration
    mkTopCompDecl (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    topName) [] Identifier
    topIdentifier Identifier
    instLabel3 [] ([[InstancePort]] -> [InstancePort]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[InstancePort]]
    iports)

      case topOutputM of
        Maybe ([InstancePort], [Declaration], Identifier)
    Nothing ->
          [Declaration] -> NetlistMonad [Declaration]
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([InstancePort] -> Declaration
    topDecl [] Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    : [[Declaration]] -> [Declaration]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[Declaration]]
    iResult)
        Just ([InstancePort]
    oports, [Declaration]
    unwrappers, Identifier
    id0) -> do
          outpAssign <- HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign ((Identifier, HWType) -> Identifier
    forall a b. (a, b) -> a
    fst (Identifier, HWType)
    dstId) (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id0 Maybe Modifier
    forall a. Maybe a
    Nothing)
          pure (concat iResult ++ tickDecls ++ (topDecl oports:unwrappers) ++ [outpAssign])

    data InstancePort = InstancePort
      { InstancePort -> Identifier
    ip_id :: Identifier
      -- ^ Identifier to assign. Top entities are instantiated using positional
      -- arguments, so this doesn't hold a port name.
      , InstancePort -> HWType
    ip_type :: HWType
      -- ^ Type assigned to port
      } deriving Int -> InstancePort -> [Char] -> [Char]
    [InstancePort] -> [Char] -> [Char]
    InstancePort -> [Char]
    (Int -> InstancePort -> [Char] -> [Char])
    -> (InstancePort -> [Char])
    -> ([InstancePort] -> [Char] -> [Char])
    -> Show InstancePort
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> InstancePort -> [Char] -> [Char]
    showsPrec :: Int -> InstancePort -> [Char] -> [Char]
    $cshow :: InstancePort -> [Char]
    show :: InstancePort -> [Char]
    $cshowList :: [InstancePort] -> [Char] -> [Char]
    showList :: [InstancePort] -> [Char] -> [Char]
    Show

    -- | Generate input port(s) associated with a single argument for an
    -- instantiation of a top entity. This function composes the input ports into
    -- a single signal and returns its name.
    mkTopInstInput
      :: ExpandedPortName Identifier
      -- ^ The @PortName@ of a _TopEntity_ annotation for this input.
      -> NetlistMonad ([InstancePort], [Declaration], Identifier)
      -- ^ (ports to assign, declarations for intermediate signals, argument signal)
    mkTopInstInput :: ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstInput (ExpandedPortName HWType
    hwty0 Identifier
    pN) = do
      pN' <- Identifier -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    pN
      (decls, pN'', _bvExpr, hwty1) <- toPrimitiveType pN' hwty0
      return ( [InstancePort pN'' hwty1]
              , NetDecl' Nothing pN' hwty0 Nothing : decls
              , pN' )

    mkTopInstInput epp :: ExpandedPortName Identifier
    epp@(ExpandedPortProduct Text
    pNameHint HWType
    hwty0 [ExpandedPortName Identifier]
    ps) = do
      pName <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    pNameHint
      let pDecl = Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    pName HWType
    hwty0 Maybe Expr
    forall a. Maybe a
    Nothing

      let
        (attrs, hwty1) = stripAttributes hwty0
        indexPN Int
    constr Int
    n = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    pName (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (HWType
    hwty0, Int
    constr, Int
    n)))

      case hwty1 of
        Vector {} -> do
          (ports, decls, ids) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstInput [ExpandedPortName Identifier]
    ps
          assigns <- zipWithM contAssign ids (map (indexPN 10) [0..])
          if null attrs then
            return (concat ports, pDecl:assigns ++ concat decls, pName)
          else
            throwAnnotatedSplitError $(curLoc) "Vector"

        RTree {} -> do
          (ports, decls, ids) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstInput [ExpandedPortName Identifier]
    ps
          assigns <- zipWithM contAssign ids (map (indexPN 10) [0..])
          if null attrs then
            return (concat ports, pDecl:assigns ++ concat decls, pName)
          else
            throwAnnotatedSplitError $(curLoc) "RTree"

        Product {} -> do
          (ports, decls, ids) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstInput [ExpandedPortName Identifier]
    ps
          assigns <- zipWithM contAssign ids (map (indexPN 0) [0..])
          if null attrs then
            return (concat ports, pDecl:assigns ++ concat decls, pName)
          else
            throwAnnotatedSplitError $(curLoc) "Product"

        SP Text
    _ (([[HWType]] -> [HWType]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[HWType]] -> [HWType])
    -> ([(Text, [HWType])] -> [[HWType]])
    -> [(Text, [HWType])]
    -> [HWType]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [[HWType]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) -> [HWType
    elTy]) -> do
          (ports, decls, ids) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstInput [ExpandedPortName Identifier]
    ps
          case ids of
            [Identifier
    conId,Identifier
    elId] -> do
              let
                conIx :: Modifier
    conIx = (HWType, Int, Int) -> Modifier
    Sliced
                  ( Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty1)
                  , HWType -> Int
    typeSize HWType
    hwty1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                  , HWType -> Int
    typeSize HWType
    elTy )

                elIx :: Modifier
    elIx = (HWType, Int, Int) -> Modifier
    Sliced
                  ( Int -> HWType
    BitVector (HWType -> Int
    typeSize HWType
    hwty1)
                  , HWType -> Int
    typeSize HWType
    elTy Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                  , Int
    0 )

              assigns <- [NetlistMonad Declaration] -> NetlistMonad [Declaration]
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence
                  [ HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    conId (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    pName (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just Modifier
    conIx))
                  , HasCallStack => Identifier -> Expr -> NetlistMonad Declaration
    Identifier -> Expr -> NetlistMonad Declaration
    contAssign Identifier
    elId  (Maybe Identifier -> HWType -> Expr -> Expr
    FromBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    elTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    pName (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just Modifier
    elIx))) ]

              return (concat ports, pDecl:assigns ++ concat decls, pName)
            [Identifier]
    _ -> [Char] -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Internal error: Unexpected error for PortProduct"
        HWType
    _ ->
          [Char]
    -> HWType
    -> ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    forall a. [Char] -> HWType -> ExpandedPortName Identifier -> a
    portProductError $(curLoc) HWType
    hwty0 ExpandedPortName Identifier
    epp

    -- | Consider the following type signature:
    --
    -- @
    --   f :: Signal dom (Vec 6 A) \`Annotate\` Attr "keep"
    --     -> Signal dom (Vec 6 B)
    -- @
    --
    -- What does the annotation mean, considering that Clash will split these
    -- vectors into multiple in- and output ports? Should we apply the annotation
    -- to all individual ports? How would we handle pin mappings? For now, we simply
    -- throw an error. This is a helper function to do so.
    throwAnnotatedSplitError
      :: String
      -> String
      -> NetlistMonad a
    throwAnnotatedSplitError :: forall a. [Char] -> [Char] -> NetlistMonad a
    throwAnnotatedSplitError [Char]
    loc [Char]
    typ = 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 (loc ++ printf msg typ typ) Nothing
     where
      msg :: [Char]
    msg = [[Char]] -> [Char]
    unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [ [Char]
    "Attempted to split %s into a number of HDL ports. This"
                      , [Char]
    "is not allowed in combination with attribute annotations."
                      , [Char]
    "You can annotate %s's components by splitting it up"
                      , [Char]
    "manually." ]

    -- | Generate output port(s) for an instantiation of a top entity. This function
    -- combines all output ports into a signal identifier and returns its name.
    mkTopInstOutput
      :: HasCallStack
      => ExpandedPortName Identifier
      -- ^ The @PortName@ of a _TopEntity_ annotation for this output
      -> NetlistMonad ([InstancePort], [Declaration], Identifier)
      -- ^ (ports to assign, declarations for intermediate signals, result signal)
    mkTopInstOutput :: HasCallStack =>
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstOutput (ExpandedPortName HWType
    hwty0 Identifier
    portName) = do
      assignName0 <- Identifier -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Identifier -> m Identifier
    Id.next Identifier
    portName
      (decls, assignName1, _expr, hwty1) <- fromPrimitiveType assignName0 hwty0
      let net = Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    assignName0 HWType
    hwty1 Maybe Expr
    forall a. Maybe a
    Nothing
      return ([InstancePort assignName0 hwty1], net : decls, assignName1)

    mkTopInstOutput epp :: ExpandedPortName Identifier
    epp@(ExpandedPortProduct Text
    productNameHint HWType
    hwty [ExpandedPortName Identifier]
    ps) = do
      pName <- Text -> NetlistMonad Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    productNameHint
      let pDecl = Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    pName HWType
    hwty Maybe Expr
    forall a. Maybe a
    Nothing
      let (attrs, hwty') = stripAttributes hwty
      case hwty' of
        Vector Int
    sz HWType
    hwty'' -> do
          (ports, decls, ids0) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 HasCallStack =>
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstOutput [ExpandedPortName Identifier]
    ps
          let ids1 = (Identifier -> Expr) -> [Identifier] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Identifier -> Maybe Modifier -> Expr)
    -> Maybe Modifier -> Identifier -> Expr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Identifier -> Maybe Modifier -> Expr
    Identifier Maybe Modifier
    forall a. Maybe a
    Nothing) [Identifier]
    ids0
          netassgn <- contAssign pName (mkVectorChain sz hwty'' ids1)
          if null attrs then
            return (concat ports, pDecl:netassgn:concat decls, pName)
          else
            throwAnnotatedSplitError $(curLoc) "Vector"

        RTree Int
    d HWType
    hwty'' -> do
          (ports, decls, ids0) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 HasCallStack =>
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstOutput [ExpandedPortName Identifier]
    ps
          let ids1 = (Identifier -> Expr) -> [Identifier] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Identifier -> Maybe Modifier -> Expr)
    -> Maybe Modifier -> Identifier -> Expr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Identifier -> Maybe Modifier -> Expr
    Identifier Maybe Modifier
    forall a. Maybe a
    Nothing) [Identifier]
    ids0
          netassgn <- contAssign pName (mkRTreeChain d hwty'' ids1)
          if null attrs then
            return (concat ports, pDecl:netassgn:concat decls, pName)
          else
            throwAnnotatedSplitError $(curLoc) "RTree"

        Product {} -> do
          (ports, decls, ids0) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 HasCallStack =>
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstOutput [ExpandedPortName Identifier]
    ps
          let ids1 = (Identifier -> Expr) -> [Identifier] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Identifier -> Maybe Modifier -> Expr)
    -> Maybe Modifier -> Identifier -> Expr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Identifier -> Maybe Modifier -> Expr
    Identifier Maybe Modifier
    forall a. Maybe a
    Nothing) [Identifier]
    ids0
          netassgn <- contAssign pName (DataCon hwty (DC (hwty,0)) ids1)
          if null attrs then
            return (concat ports, pDecl:netassgn:concat decls, pName)
          else
            throwAnnotatedSplitError $(curLoc) "Product"

        SP Text
    _ (([[HWType]] -> [HWType]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[HWType]] -> [HWType])
    -> ([(Text, [HWType])] -> [[HWType]])
    -> [(Text, [HWType])]
    -> [HWType]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [[HWType]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, [HWType]) -> [HWType]
    forall a b. (a, b) -> b
    snd) -> [HWType
    elTy]) -> do
          (ports, decls, ids0) <- [([InstancePort], [Declaration], Identifier)]
    -> ([[InstancePort]], [[Declaration]], [Identifier])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([([InstancePort], [Declaration], Identifier)]
     -> ([[InstancePort]], [[Declaration]], [Identifier]))
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    -> NetlistMonad ([[InstancePort]], [[Declaration]], [Identifier])
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ExpandedPortName Identifier
     -> NetlistMonad ([InstancePort], [Declaration], Identifier))
    -> [ExpandedPortName Identifier]
    -> NetlistMonad [([InstancePort], [Declaration], Identifier)]
    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 HasCallStack =>
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    mkTopInstOutput [ExpandedPortName Identifier]
    ps
          let ids1 = (Identifier -> Expr) -> [Identifier] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Identifier -> Maybe Modifier -> Expr)
    -> Maybe Modifier -> Identifier -> Expr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Identifier -> Maybe Modifier -> Expr
    Identifier Maybe Modifier
    forall a. Maybe a
    Nothing) [Identifier]
    ids0
              ids2 = case [Expr]
    ids1 of
                      [Expr
    conId, Expr
    elId] -> [Expr
    conId, Maybe Identifier -> HWType -> Expr -> Expr
    ToBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    elTy Expr
    elId]
                      [Expr]
    _ -> [Char] -> [Expr]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Unexpected error for PortProduct"
          netassgn <- contAssign pName (DataCon hwty (DC (BitVector (typeSize hwty),0)) ids2)
          return (concat ports, pDecl:netassgn:concat decls, pName)

        HWType
    _ ->
          [Char]
    -> HWType
    -> ExpandedPortName Identifier
    -> NetlistMonad ([InstancePort], [Declaration], Identifier)
    forall a. [Char] -> HWType -> ExpandedPortName Identifier -> a
    portProductError $(curLoc) HWType
    hwty' ExpandedPortName Identifier
    epp

    -- | Try to merge nested modifiers into a single modifier, needed by the VHDL
    -- and SystemVerilog backend.
    nestM :: Modifier -> Modifier -> Maybe Modifier
    nestM :: Modifier -> Modifier -> Maybe Modifier
    nestM (Nested Modifier
    a Modifier
    b) Modifier
    m2
      | Just Modifier
    m1  <- Modifier -> Modifier -> Maybe Modifier
    nestM Modifier
    a Modifier
    b  = Maybe Modifier
    -> (Modifier -> Maybe Modifier) -> Maybe Modifier -> Maybe Modifier
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> Modifier -> Modifier
    Nested Modifier
    m1 Modifier
    m2)) Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> Modifier -> Maybe Modifier
    nestM Modifier
    m1 Modifier
    m2)
      | Just Modifier
    m2' <- Modifier -> Modifier -> Maybe Modifier
    nestM Modifier
    b Modifier
    m2 = Maybe Modifier
    -> (Modifier -> Maybe Modifier) -> Maybe Modifier -> Maybe Modifier
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> Modifier -> Modifier
    Nested Modifier
    a Modifier
    m2')) Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just (Modifier -> Modifier -> Maybe Modifier
    nestM Modifier
    a Modifier
    m2')

    nestM (Indexed (Vector Int
    n HWType
    t1,Int
    1,Int
    1)) (Indexed (Vector Int
    _ HWType
    t2,Int
    1,Int
    0))
      | HWType
    t1 HWType -> HWType -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == HWType
    t2 = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    Vector Int
    n HWType
    t1,Int
    10,Int
    1))

    nestM (Indexed (Vector Int
    n HWType
    t1,Int
    1,Int
    1)) (Indexed (Vector Int
    _ HWType
    t2,Int
    10,Int
    k))
      | HWType
    t1 HWType -> HWType -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == HWType
    t2 = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    Vector Int
    n HWType
    t1,Int
    10,Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1))

    nestM (Indexed (RTree Int
    d1 HWType
    t1,Int
    1,Int
    n)) (Indexed (RTree Int
    d2 HWType
    t2,Int
    0,Int
    0))
      | HWType
    t1 HWType -> HWType -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == HWType
    t2
      , Int
    d1 Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    >= Int
    0
      , Int
    d2 Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    >= Int
    0
      = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    RTree Int
    d1 HWType
    t1,Int
    10,Int
    n))

    nestM (Indexed (RTree Int
    d1 HWType
    t1,Int
    1,Int
    n)) (Indexed (RTree Int
    d2 HWType
    t2,Int
    1,Int
    m))
      | HWType
    t1 HWType -> HWType -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == HWType
    t2
      , Int
    d1 Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    >= Int
    0
      , Int
    d2 Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    >= Int
    0
      = if | Int
    n Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    1 IsVoid -> IsVoid -> IsVoid
    && Int
    m Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    1 -> let r :: Int
    r = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    d1
                                     l :: Int
    l = Int
    r Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Int
    d1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2)
                                 in  Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    RTree (-Int
    1) HWType
    t1, Int
    l, Int
    r))
           | Int
    n Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    1 IsVoid -> IsVoid -> IsVoid
    && Int
    m Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    0 -> let l :: Int
    l = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Int
    d1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                                     r :: Int
    r = Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    l Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2)
                                 in  Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    RTree (-Int
    1) HWType
    t1, Int
    l, Int
    r))
           | Int
    n Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    0 IsVoid -> IsVoid -> IsVoid
    && Int
    m Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    1 -> let l :: Int
    l = (Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Int
    d1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                                     r :: Int
    r = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Int
    d1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                                 in  Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    RTree (-Int
    1) HWType
    t1, Int
    l, Int
    r))
           | Int
    n Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    0 IsVoid -> IsVoid -> IsVoid
    && Int
    m Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    0 -> let l :: Int
    l = Int
    0
                                     r :: Int
    r = (Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Int
    d1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                                 in  Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    RTree (-Int
    1) HWType
    t1, Int
    l, Int
    r))
           | Int
    n Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    > Int
    1 IsVoid -> IsVoid -> IsVoid
    || Int
    n Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    < Int
    0   -> [Char] -> Maybe Modifier
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe Modifier) -> [Char] -> Maybe Modifier
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nestM: n should be 0 or 1, not:" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n
           | Int
    m Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    > Int
    1 IsVoid -> IsVoid -> IsVoid
    || Int
    m Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    < Int
    0   -> [Char] -> Maybe Modifier
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe Modifier) -> [Char] -> Maybe Modifier
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nestM: m should be 0 or 1, not:" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    m
           | IsVoid
    otherwise        -> [Char] -> Maybe Modifier
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe Modifier) -> [Char] -> Maybe Modifier
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "nestM: unexpected (n, m): " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int) -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    n, Int
    m)
    nestM (Indexed (RTree (-1) HWType
    t1,Int
    l,Int
    _)) (Indexed (RTree Int
    d HWType
    t2,Int
    10,Int
    k))
      | HWType
    t1 HWType -> HWType -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == HWType
    t2
      , Int
    d  Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    >= Int
    0
      = Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (Int -> HWType -> HWType
    RTree Int
    d HWType
    t1,Int
    10,Int
    lInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    k))

    nestM Modifier
    _ Modifier
    _ = Maybe Modifier
    forall a. Maybe a
    Nothing

    -- | Determines if any type variables (exts) are bound in any of the given
    -- type or term variables (tms). It's currently only used to detect bound
    -- existentials, hence the name.
    bindsExistentials
      :: [TyVar]
      -> [Var a]
      -> Bool
    bindsExistentials :: forall a. [TyVar] -> [Var a] -> IsVoid
    bindsExistentials [TyVar]
    exts [Var a]
    tms = (TyVar -> IsVoid) -> [TyVar] -> IsVoid
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> IsVoid) -> t a -> IsVoid
    any (TyVar -> [TyVar] -> IsVoid
    forall a. Eq a => a -> [a] -> IsVoid
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> IsVoid
    `elem` [TyVar]
    freeVars) [TyVar]
    exts
     where
      freeVars :: [TyVar]
    freeVars = (Type -> [TyVar]) -> [Type] -> [TyVar]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (Getting (Endo [TyVar]) Type TyVar -> Type -> [TyVar]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    Lens.toListOf Getting (Endo [TyVar]) Type TyVar
    Fold Type TyVar
    typeFreeVars) ((Var a -> Type) -> [Var a] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Var a -> Type
    forall a. HasType a => a -> Type
    coreTypeOf [Var a]
    tms)

    iteAlts :: HWType -> [Alt] -> Maybe (Term,Term)
    iteAlts :: HWType -> [Alt] -> Maybe (Term, Term)
    iteAlts HWType
    sHTy [(Pat
    pat0,Term
    alt0),(Pat
    pat1,Term
    alt1)] | HWType -> IsVoid
    validIteSTy HWType
    sHTy = case Pat
    pat0 of
      DataPat DataCon
    dc [TyVar]
    _ [Id]
    _ -> case DataCon -> Int
    dcTag DataCon
    dc of
        Int
    2 -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt0,Term
    alt1)
        Int
    _ -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt1,Term
    alt0)
      LitPat (C.IntegerLiteral Integer
    l) -> case Integer
    l of
        Integer
    1 -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt0,Term
    alt1)
        Integer
    _ -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt1,Term
    alt0)
      Pat
    DefaultPat -> case Pat
    pat1 of
        DataPat DataCon
    dc [TyVar]
    _ [Id]
    _ -> case DataCon -> Int
    dcTag DataCon
    dc of
          Int
    2 -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt1,Term
    alt0)
          Int
    _ -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt0,Term
    alt1)
        LitPat (C.IntegerLiteral Integer
    l) -> case Integer
    l of
          Integer
    1 -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt1,Term
    alt0)
          Integer
    _ -> (Term, Term) -> Maybe (Term, Term)
    forall a. a -> Maybe a
    Just (Term
    alt0,Term
    alt1)
        Pat
    _ -> Maybe (Term, Term)
    forall a. Maybe a
    Nothing
      Pat
    _ -> Maybe (Term, Term)
    forall a. Maybe a
    Nothing
     where
      validIteSTy :: HWType -> IsVoid
    validIteSTy HWType
    Bool          = IsVoid
    True
      validIteSTy HWType
    Bit           = IsVoid
    True
      validIteSTy (Sum Text
    _ [Text
    _,Text
    _]) = IsVoid
    True
      validIteSTy (SP Text
    _ [(Text, [HWType])
    _,(Text, [HWType])
    _])  = IsVoid
    True
      validIteSTy (Unsigned Int
    1)  = IsVoid
    True
      validIteSTy (Index Integer
    2)     = IsVoid
    True
      validIteSTy HWType
    _             = IsVoid
    False

    iteAlts HWType
    _ [Alt]
    _ = Maybe (Term, Term)
    forall a. Maybe a
    Nothing

    -- | Run a NetlistMonad computation in the context of the given source ticks and
    -- name modifier ticks
    withTicks
      :: [TickInfo]
      -> ([Declaration] -> NetlistMonad a)
      -- ^ The source ticks are turned into 'TickDecl's and are passed as an argument
      -- to the NetlistMonad computation. Name modifier ticks will change the local
      -- environment for the NetlistMonad computation.
      -> NetlistMonad a
    withTicks :: forall a.
    [TickInfo] -> ([Declaration] -> NetlistMonad a) -> NetlistMonad a
    withTicks [TickInfo]
    ticks0 [Declaration] -> NetlistMonad a
    k = do
      let ticks1 :: [TickInfo]
    ticks1 = [TickInfo] -> [TickInfo]
    forall a. Eq a => [a] -> [a]
    List.nub [TickInfo]
    ticks0
      [Declaration] -> [TickInfo] -> NetlistMonad a
    go [] ([TickInfo] -> [TickInfo]
    forall a. [a] -> [a]
    reverse [TickInfo]
    ticks1)
     where
      go :: [Declaration] -> [TickInfo] -> NetlistMonad a
    go [Declaration]
    decls [] = [Declaration] -> NetlistMonad a
    k ([Declaration] -> [Declaration]
    forall a. [a] -> [a]
    reverse [Declaration]
    decls)

      go [Declaration]
    decls (TickInfo
    DeDup:[TickInfo]
    ticks) = [Declaration] -> [TickInfo] -> NetlistMonad a
    go [Declaration]
    decls [TickInfo]
    ticks

      go [Declaration]
    decls (TickInfo
    NoDeDup:[TickInfo]
    ticks) = [Declaration] -> [TickInfo] -> NetlistMonad a
    go [Declaration]
    decls [TickInfo]
    ticks

      go [Declaration]
    decls (SrcSpan SrcSpan
    sp:[TickInfo]
    ticks) =
        [Declaration] -> [TickInfo] -> NetlistMonad a
    go (CommentOrDirective -> Declaration
    TickDecl (Text -> CommentOrDirective
    Comment ([Char] -> Text
    Text.pack (SDoc -> [Char]
    showSDocUnsafe (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    sp))))Declaration -> [Declaration] -> [Declaration]
    forall a. a -> [a] -> [a]
    :[Declaration]
    decls) [TickInfo]
    ticks

      go [Declaration]
    decls (NameMod NameMod
    m Type
    nm0:[TickInfo]
    ticks) = do
        tcm <- Getting TyConMap NetlistEnv TyConMap -> NetlistMonad TyConMap
    forall s (m :: Type -> Type) a.
    MonadReader s m =>
    Getting a s a -> m a
    Lens.view Getting TyConMap NetlistEnv TyConMap
    Getter NetlistEnv TyConMap
    tcCache
        case runExcept (tyLitShow tcm nm0) of
          Right [Char]
    nm1 -> (NetlistEnv -> NetlistEnv) -> NetlistMonad a -> NetlistMonad a
    forall a.
    (NetlistEnv -> NetlistEnv) -> NetlistMonad a -> NetlistMonad a
    forall r (m :: Type -> Type) a.
    MonadReader r m =>
    (r -> r) -> m a -> m a
    local (NameMod -> [Char] -> NetlistEnv -> NetlistEnv
    modName NameMod
    m [Char]
    nm1) ([Declaration] -> [TickInfo] -> NetlistMonad a
    go [Declaration]
    decls [TickInfo]
    ticks)
          Either [Char] [Char]
    _ -> [Declaration] -> [TickInfo] -> NetlistMonad a
    go [Declaration]
    decls [TickInfo]
    ticks

      modName :: NameMod -> [Char] -> NetlistEnv -> NetlistEnv
    modName NameMod
    PrefixName ([Char] -> Text
    Text.pack -> Text
    s2) env :: NetlistEnv
    env@(NetlistEnv {_prefixName :: NetlistEnv -> Text
    _prefixName = Text
    s1})
        | Text -> IsVoid
    Text.null Text
    s1 = NetlistEnv
    env {_prefixName = s2}
        | IsVoid
    otherwise    = NetlistEnv
    env {_prefixName = s1 <> "_" <> s2}
      modName NameMod
    SuffixName ([Char] -> Text
    Text.pack -> Text
    s2) env :: NetlistEnv
    env@(NetlistEnv {_suffixName :: NetlistEnv -> Text
    _suffixName = Text
    s1})
        | Text -> IsVoid
    Text.null Text
    s1 = NetlistEnv
    env {_suffixName = s2}
        | IsVoid
    otherwise    = NetlistEnv
    env {_suffixName = s2 <> "_" <> s1}
      modName NameMod
    SuffixNameP ([Char] -> Text
    Text.pack -> Text
    s2) env :: NetlistEnv
    env@(NetlistEnv {_suffixName :: NetlistEnv -> Text
    _suffixName = Text
    s1})
        | Text -> IsVoid
    Text.null Text
    s1 = NetlistEnv
    env {_suffixName = s2}
        | IsVoid
    otherwise    = NetlistEnv
    env {_suffixName = s1 <> "_" <> s2}
      modName NameMod
    SetName ([Char] -> Text
    Text.pack -> Text
    s) NetlistEnv
    env = NetlistEnv
    env {_setName = Just s}

    -- | Add the pre- and suffix names in the current environment to the given
    -- identifier
    affixName
      :: Text
      -> NetlistMonad Text
    affixName :: Text -> NetlistMonad Text
    affixName Text
    nm0 = do
      NetlistEnv _ pre suf _ <- NetlistMonad NetlistEnv
    forall r (m :: Type -> Type). MonadReader r m => m r
    ask
      let nm1 = if Text -> IsVoid
    Text.null Text
    pre then Text
    nm0 else Text
    pre Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    nm0
          nm2 = if Text -> IsVoid
    Text.null Text
    suf then Text
    nm1 else Text
    nm1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    suf
      return nm2

    -- | Errors 'expandTopEntity' might yield
    data ExpandError
      -- | Synthesis attributes are not supported on PortProducts
      = AttrError [Attr Text]
      -- | Something was annotated as being a PortProduct, but wasn't one
      | PortProductError PortName HWType

    -- | Same as 'expandTopEntity', but also adds identifiers to the identifier
    -- set of the monad.
    expandTopEntityOrErrM
      :: HasCallStack
      => [(Maybe Id, FilteredHWType)]
      -- ^ Arguments. Ids are used as name hints.
      -> (Maybe Id, FilteredHWType)
      -- ^ Result. Id is used as name hint.
      -> Maybe TopEntity
      -- ^ If /Nothing/, an expanded top entity will be generated as if /defSyn/
      -- was passed.
      -> NetlistMonad (ExpandedTopEntity Identifier)
      -- ^ Either some error (see "ExpandError") or and expanded top entity. All
      -- identifiers in the expanded top entity will be added to NetlistState's
      -- IdentifierSet.
    expandTopEntityOrErrM :: HasCallStack =>
    [(Maybe Id, FilteredHWType)]
    -> (Maybe Id, FilteredHWType)
    -> Maybe TopEntity
    -> NetlistMonad (ExpandedTopEntity Identifier)
    expandTopEntityOrErrM [(Maybe Id, FilteredHWType)]
    ihwtys (Maybe Id, FilteredHWType)
    ohwty Maybe TopEntity
    topM = do
      is <- (IdentifierSet -> IdentifierSet) -> NetlistMonad IdentifierSet
    forall (m :: Type -> Type).
    IdentifierSetMonad m =>
    (IdentifierSet -> IdentifierSet) -> m IdentifierSet
    identifierSetM IdentifierSet -> IdentifierSet
    forall a. a -> a
    id

      case expandTopEntity ihwtys ohwty topM of
        Left (AttrError [Attr Text]
    attrs) ->
          ([Char] -> NetlistMonad (ExpandedTopEntity Identifier)
    forall a. HasCallStack => [Char] -> a
    error [I.i|
            Cannot use attribute annotations on product types of top entities. Saw
            annotation:

              #{attrs}
          |])
        Left (PortProductError PortName
    pn HWType
    hwty) ->
          ([Char] -> NetlistMonad (ExpandedTopEntity Identifier)
    forall a. HasCallStack => [Char] -> a
    error [I.i|
            Saw a PortProduct in a Synthesize annotation:

              #{pn}

            but the port type:

              #{hwty}

            is not a product!
          |])
        Right ExpandedTopEntity (Either Text Text)
    eTop -> do
          let ete :: ExpandedTopEntity Identifier
    ete = State IdentifierSet (ExpandedTopEntity Identifier)
    -> IdentifierSet -> ExpandedTopEntity Identifier
    forall s a. State s a -> s -> a
    evalState ((Either Text Text -> StateT IdentifierSet Identity Identifier)
    -> ExpandedTopEntity (Either Text Text)
    -> State IdentifierSet (ExpandedTopEntity Identifier)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> ExpandedTopEntity a -> f (ExpandedTopEntity b)
    traverse ((Text -> StateT IdentifierSet Identity Identifier)
    -> (Text -> StateT IdentifierSet Identity Identifier)
    -> Either Text Text
    -> StateT IdentifierSet Identity Identifier
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> StateT IdentifierSet Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.addRaw Text -> StateT IdentifierSet Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic) ExpandedTopEntity (Either Text Text)
    eTop) (IdentifierSet -> IdentifierSet
    Id.clearSet IdentifierSet
    is)
          [Identifier] -> NetlistMonad ()
    forall (m :: Type -> Type) (t :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m, Foldable t) =>
    t Identifier -> m ()
    Id.addMultiple (ExpandedTopEntity Identifier -> [Identifier]
    forall a. ExpandedTopEntity a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList ExpandedTopEntity Identifier
    ete)
          ExpandedTopEntity Identifier
    -> NetlistMonad (ExpandedTopEntity Identifier)
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ExpandedTopEntity Identifier
    ete

    -- | Take a top entity and /expand/ its port names. I.e., make sure that every
    -- port that should be generated in the HDL is part of the data structure. It
    -- works on "FilteredHWType" in order to generate stable port names.
    expandTopEntity
      :: HasCallStack
      => [(Maybe Id, FilteredHWType)]
      -- ^ Arguments. Ids are used as name hints.
      -> (Maybe Id, FilteredHWType)
      -- ^ Result. Id is used as name hint.
      -> Maybe TopEntity
      -- ^ Top entity to expand
      -> Either ExpandError (ExpandedTopEntity (Either Text Text))
      -- ^ Either some error (see "ExpandError") or and expanded top entity. The
      -- expanded top entity in turn contains an Either too. /Left/ means that
      -- the name was supplied by the user and should be inserted at verbatim,
      -- /Right/ is a name generated by Clash.
    expandTopEntity :: HasCallStack =>
    [(Maybe Id, FilteredHWType)]
    -> (Maybe Id, FilteredHWType)
    -> Maybe TopEntity
    -> Either ExpandError (ExpandedTopEntity (Either Text Text))
    expandTopEntity [(Maybe Id, FilteredHWType)]
    ihwtys (Maybe Id
    oId, FilteredHWType
    ohwty) Maybe TopEntity
    topEntityM
      | Synthesize {[Char]
    [PortName]
    PortName
    t_name :: TopEntity -> [Char]
    t_name :: [Char]
    t_inputs :: [PortName]
    t_output :: PortName
    t_output :: TopEntity -> PortName
    t_inputs :: TopEntity -> [PortName]
    ..} <- TopEntity -> Maybe TopEntity -> TopEntity
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> TopEntity
    defSyn ([Char] -> [Char]
    forall a. HasCallStack => [Char] -> a
    error $(curLoc))) Maybe TopEntity
    topEntityM = do
      -- TODO 1: Check sizes against number of PortProduct fields
      -- TODO 2: Warn about duplicate fields
      let
        argHints :: [Text]
    argHints = ((Maybe Id, FilteredHWType) -> Text)
    -> [(Maybe Id, FilteredHWType)] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> (Id -> Text) -> Maybe Id -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "arg" (Identifier -> Text
    Id.toText (Identifier -> Text) -> (Id -> Identifier) -> Id -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId) (Maybe Id -> Text)
    -> ((Maybe Id, FilteredHWType) -> Maybe Id)
    -> (Maybe Id, FilteredHWType)
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe Id, FilteredHWType) -> Maybe Id
    forall a b. (a, b) -> a
    fst) [(Maybe Id, FilteredHWType)]
    ihwtys
        resHint :: Text
    resHint = Text -> (Id -> Text) -> Maybe Id -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "result" (Identifier -> Text
    Id.toText (Identifier -> Text) -> (Id -> Identifier) -> Id -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Id -> Identifier
    Id -> Identifier
    Id.unsafeFromCoreId) Maybe Id
    oId

      inputs <- (Text
     -> FilteredHWType
     -> Maybe PortName
     -> Either
          ExpandError (Maybe (ExpandedPortName (Either Text Text))))
    -> [Text]
    -> [FilteredHWType]
    -> [Maybe PortName]
    -> Either ExpandError [Maybe (ExpandedPortName (Either Text Text))]
    forall (m :: Type -> Type) a b c d.
    Monad m =>
    (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
    zipWith3M Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (Maybe (ExpandedPortName (Either Text Text)))
    goInput [Text]
    argHints (((Maybe Id, FilteredHWType) -> FilteredHWType)
    -> [(Maybe Id, FilteredHWType)] -> [FilteredHWType]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe Id, FilteredHWType) -> FilteredHWType
    forall a b. (a, b) -> b
    snd [(Maybe Id, FilteredHWType)]
    ihwtys) ([PortName] -> [Maybe PortName]
    extendPorts [PortName]
    t_inputs)

      output <-
        -- BiSignalOut signals are filtered as their counterpart - BiSignalIn - will
        -- be printed as an inout port in HDL.
        if isVoid (stripFiltered ohwty) || isBiSignalOut (stripFiltered ohwty) then
          pure Nothing
        else
          Just <$> goPort resHint ohwty t_output

      pure (ExpandedTopEntity {
          et_inputs = inputs
        , et_output = output
        })
     where
      goInput
        :: Text
        -> FilteredHWType
        -> Maybe PortName
        -> Either ExpandError (Maybe (ExpandedPortName (Either Text Text)))
      goInput :: Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (Maybe (ExpandedPortName (Either Text Text)))
    goInput Text
    hint fHwty :: FilteredHWType
    fHwty@(FilteredHWType HWType
    hwty [[(IsVoid, FilteredHWType)]]
    _) Maybe PortName
    pM
        | HWType -> IsVoid
    isVoid HWType
    hwty = Maybe (ExpandedPortName (Either Text Text))
    -> Either ExpandError (Maybe (ExpandedPortName (Either Text Text)))
    forall a b. b -> Either a b
    Right Maybe (ExpandedPortName (Either Text Text))
    forall a. Maybe a
    Nothing
        | IsVoid
    otherwise = ExpandedPortName (Either Text Text)
    -> Maybe (ExpandedPortName (Either Text Text))
    forall a. a -> Maybe a
    Just (ExpandedPortName (Either Text Text)
     -> Maybe (ExpandedPortName (Either Text Text)))
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    -> Either ExpandError (Maybe (ExpandedPortName (Either Text Text)))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    go Text
    hint FilteredHWType
    fHwty Maybe PortName
    pM

      -- Vector and RTree are hardcoded as product types, even when instantiated as
      -- /Vec 1 a/ or /RTree 0 a/ respectively.
      isProduct :: FilteredHWType -> Bool
      isProduct :: FilteredHWType -> IsVoid
    isProduct (FilteredHWType (CustomProduct {}) [[(IsVoid, FilteredHWType)]]
    _) =
        -- CustomProducts are not yet support in mkTopInput/mkTopOutput so we can't treat
        -- them as product types.
        -- FIXME: Support CustomProduct in top entity annotations
        IsVoid
    False
      isProduct (FilteredHWType (Vector {}) [[(IsVoid, FilteredHWType)]]
    _) = IsVoid
    True
      isProduct (FilteredHWType (RTree {}) [[(IsVoid, FilteredHWType)]]
    _) = IsVoid
    True
      isProduct (FilteredHWType HWType
    _ [((IsVoid, FilteredHWType)
    _:(IsVoid, FilteredHWType)
    _:[(IsVoid, FilteredHWType)]
    _)]) = IsVoid
    True
      isProduct FilteredHWType
    _ = IsVoid
    False

      go
        :: Text
        -> FilteredHWType
        -> Maybe PortName
        -> Either ExpandError (ExpandedPortName (Either Text Text))
      go :: Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    go Text
    hint FilteredHWType
    hwty Maybe PortName
    Nothing = Text
    -> FilteredHWType
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goNoPort Text
    hint FilteredHWType
    hwty
      go Text
    hint FilteredHWType
    hwty (Just PortName
    p) = Text
    -> FilteredHWType
    -> PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goPort Text
    hint FilteredHWType
    hwty PortName
    p

      goPort
        :: Text
        -> FilteredHWType
        -> PortName
        -> Either ExpandError (ExpandedPortName (Either Text Text))
      goPort :: Text
    -> FilteredHWType
    -> PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goPort Text
    hint fHwty :: FilteredHWType
    fHwty@(FilteredHWType HWType
    hwty [[(IsVoid, FilteredHWType)]]
    _) (PortName [Char]
    "") =
        -- TODO: The following logic makes using /no/ top entity annotation and
        -- TODO: using 'defSyn' behave differently. This is probably not what we
        -- TODO: want.
        if Maybe TopEntity -> IsVoid
    forall a. Maybe a -> IsVoid
    isJust Maybe TopEntity
    topEntityM then
          -- If top entity annotation was explicitly given, render a single port
          ExpandedPortName (Either Text Text)
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a. a -> Either ExpandError a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Either Text Text -> ExpandedPortName (Either Text Text)
    forall a. HWType -> a -> ExpandedPortName a
    ExpandedPortName HWType
    hwty (Text -> Either Text Text
    forall a b. b -> Either a b
    Right Text
    hint))
        else
          -- Treat empty 'PortName's as an non-annotated port if no explicit
          -- synthesize annotation was given.
          Text
    -> FilteredHWType
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goNoPort Text
    hint FilteredHWType
    fHwty
      goPort Text
    _hint (FilteredHWType HWType
    hwty [[(IsVoid, FilteredHWType)]]
    _) (PortName [Char]
    pn) =
        ExpandedPortName (Either Text Text)
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a. a -> Either ExpandError a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Either Text Text -> ExpandedPortName (Either Text Text)
    forall a. HWType -> a -> ExpandedPortName a
    ExpandedPortName HWType
    hwty (Text -> Either Text Text
    forall a b. a -> Either a b
    Left ([Char] -> Text
    Text.pack [Char]
    pn)))
      goPort Text
    hint0 fHwty :: FilteredHWType
    fHwty@(FilteredHWType HWType
    hwty0 [[(IsVoid, FilteredHWType)]]
    fields0) pp :: PortName
    pp@(PortProduct [Char]
    p [PortName]
    ps0)
        -- Attrs not allowed on product types
        | FilteredHWType -> IsVoid
    isProduct FilteredHWType
    fHwty
        , (Attr Text
    _:[Attr Text]
    _) <- [Attr Text]
    attrs
        = ExpandError
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a b. a -> Either a b
    Left ([Attr Text] -> ExpandError
    AttrError [Attr Text]
    attrs)

        -- Product types (products, vec, rtree) of which all but one field are
        -- zero-width.
        | FilteredHWType -> IsVoid
    isProduct FilteredHWType
    fHwty
        , [[(IsVoid, FilteredHWType)]
    fields1] <- [[(IsVoid, FilteredHWType)]]
    fields0
        , (((IsVoid, FilteredHWType)
    _:[(IsVoid, FilteredHWType)]
    _), [(IsVoid, FilteredHWType)
    _]) <- ((IsVoid, FilteredHWType) -> IsVoid)
    -> [(IsVoid, FilteredHWType)]
    -> ([(IsVoid, FilteredHWType)], [(IsVoid, FilteredHWType)])
    forall a. (a -> IsVoid) -> [a] -> ([a], [a])
    partition (IsVoid, FilteredHWType) -> IsVoid
    forall a b. (a, b) -> a
    fst [(IsVoid, FilteredHWType)]
    fields1
        = case [Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    go Text
    h FilteredHWType
    t Maybe PortName
    p_ | (Text
    h, (IsVoid
    False, FilteredHWType
    t), Maybe PortName
    p_) <- [Text]
    -> [(IsVoid, FilteredHWType)]
    -> [Maybe PortName]
    -> [(Text, (IsVoid, FilteredHWType), Maybe PortName)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Text]
    hints [(IsVoid, FilteredHWType)]
    fields1 [Maybe PortName]
    ps1] of
            Either ExpandError (ExpandedPortName (Either Text Text))
    port:[Either ExpandError (ExpandedPortName (Either Text Text))]
    _ -> Either ExpandError (ExpandedPortName (Either Text Text))
    port
            [Either ExpandError (ExpandedPortName (Either Text Text))]
    _ -> [Char] -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insuffient ports"

        -- Product types (products, vec, rtree)
        | FilteredHWType -> IsVoid
    isProduct FilteredHWType
    fHwty
        , [[(IsVoid, FilteredHWType)]
    fields1] <- [[(IsVoid, FilteredHWType)]]
    fields0
        = Text
    -> HWType
    -> [ExpandedPortName (Either Text Text)]
    -> ExpandedPortName (Either Text Text)
    forall a.
    Text -> HWType -> [ExpandedPortName a] -> ExpandedPortName a
    ExpandedPortProduct Text
    hint1 HWType
    hwty1 ([ExpandedPortName (Either Text Text)]
     -> ExpandedPortName (Either Text Text))
    -> Either ExpandError [ExpandedPortName (Either Text Text)]
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            [Either ExpandError (ExpandedPortName (Either Text Text))]
    -> Either ExpandError [ExpandedPortName (Either Text Text)]
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence [Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    go Text
    h FilteredHWType
    t Maybe PortName
    p_ | (Text
    h, (IsVoid
    False, FilteredHWType
    t), Maybe PortName
    p_) <- [Text]
    -> [(IsVoid, FilteredHWType)]
    -> [Maybe PortName]
    -> [(Text, (IsVoid, FilteredHWType), Maybe PortName)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Text]
    hints [(IsVoid, FilteredHWType)]
    fields1 [Maybe PortName]
    ps1]

        -- Things like "Maybe a" are allowed to be split up using a port
        -- annotation (but won't be split up if it's missing, should it?)
        -- FIXME: We probably shouldn't filter void constructs here, it's
        -- FIXME: inconsistent with how we deal with port annotations elsewhere
        | [(IsVoid
    False, FilteredHWType
    eHwty)] <- ((IsVoid, FilteredHWType) -> IsVoid)
    -> [(IsVoid, FilteredHWType)] -> [(IsVoid, FilteredHWType)]
    forall a. (a -> IsVoid) -> [a] -> [a]
    filter (IsVoid -> IsVoid
    not (IsVoid -> IsVoid)
    -> ((IsVoid, FilteredHWType) -> IsVoid)
    -> (IsVoid, FilteredHWType)
    -> IsVoid
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IsVoid, FilteredHWType) -> IsVoid
    forall a b. (a, b) -> a
    fst) ([[(IsVoid, FilteredHWType)]] -> [(IsVoid, FilteredHWType)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[(IsVoid, FilteredHWType)]]
    fields0)
        , [[(IsVoid, FilteredHWType)]] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [[(IsVoid, FilteredHWType)]]
    fields0 Int -> Int -> IsVoid
    forall a. Ord a => a -> a -> IsVoid
    > Int
    1
        , [PortName] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [PortName]
    ps0 Int -> Int -> IsVoid
    forall a. Eq a => a -> a -> IsVoid
    == Int
    2
        , FilteredHWType
    conHwty <- HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
    FilteredHWType (Int -> HWType
    BitVector (HWType -> Int
    conSize HWType
    hwty0)) []
        = Text
    -> HWType
    -> [ExpandedPortName (Either Text Text)]
    -> ExpandedPortName (Either Text Text)
    forall a.
    Text -> HWType -> [ExpandedPortName a] -> ExpandedPortName a
    ExpandedPortProduct Text
    hint1 HWType
    hwty1 ([ExpandedPortName (Either Text Text)]
     -> ExpandedPortName (Either Text Text))
    -> Either ExpandError [ExpandedPortName (Either Text Text)]
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            [Either ExpandError (ExpandedPortName (Either Text Text))]
    -> Either ExpandError [ExpandedPortName (Either Text Text)]
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence [Text
    -> FilteredHWType
    -> Maybe PortName
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    go Text
    h FilteredHWType
    t Maybe PortName
    p_ | (Text
    h, FilteredHWType
    t, Maybe PortName
    p_) <- [Text]
    -> [FilteredHWType]
    -> [Maybe PortName]
    -> [(Text, FilteredHWType, Maybe PortName)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Text]
    hints [FilteredHWType
    conHwty, FilteredHWType
    eHwty] [Maybe PortName]
    ps1]

        -- Port annotated as PortProduct, but wasn't one
        | IsVoid
    otherwise
        = ExpandError
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a b. a -> Either a b
    Left (PortName -> HWType -> ExpandError
    PortProductError PortName
    pp HWType
    hwty1)

       where
        hint1 :: Text
    hint1 = if [Char] -> IsVoid
    forall a. [a] -> IsVoid
    forall (t :: Type -> Type) a. Foldable t => t a -> IsVoid
    null [Char]
    p then Text
    hint0 else [Char] -> Text
    Text.pack [Char]
    p
        ps1 :: [Maybe PortName]
    ps1 = [PortName] -> [Maybe PortName]
    extendPorts ((PortName -> PortName) -> [PortName] -> [PortName]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> PortName -> PortName
    prefixParent [Char]
    p) [PortName]
    ps0)
        hints :: [Text]
    hints = (Int -> Text) -> [Int] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Int
    i -> Text
    hint1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showt Int
    i) [(Int
    0::Int)..]
        ([Attr Text]
    attrs, HWType
    hwty1) = HWType -> ([Attr Text], HWType)
    stripAttributes HWType
    hwty0

      goNoPort
        :: Text
        -> FilteredHWType
        -> Either ExpandError (ExpandedPortName (Either Text Text))
      goNoPort :: Text
    -> FilteredHWType
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goNoPort Text
    hint fHwty :: FilteredHWType
    fHwty@(FilteredHWType HWType
    hwty0 [[(IsVoid, FilteredHWType)]]
    fields0)
        -- Attrs not allowed on product types
        | FilteredHWType -> IsVoid
    isProduct FilteredHWType
    fHwty
        , (Attr Text
    _:[Attr Text]
    _) <- [Attr Text]
    attrs
        = ExpandError
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a b. a -> Either a b
    Left ([Attr Text] -> ExpandError
    AttrError [Attr Text]
    attrs)

        -- Product types (products, vec, rtree) of which all but one field are
        -- zero-width.
        | FilteredHWType -> IsVoid
    isProduct FilteredHWType
    fHwty
        , [[(IsVoid, FilteredHWType)]
    fields1] <- [[(IsVoid, FilteredHWType)]]
    fields0
        , (((IsVoid, FilteredHWType)
    _:[(IsVoid, FilteredHWType)]
    _), [(IsVoid, FilteredHWType)
    _]) <- ((IsVoid, FilteredHWType) -> IsVoid)
    -> [(IsVoid, FilteredHWType)]
    -> ([(IsVoid, FilteredHWType)], [(IsVoid, FilteredHWType)])
    forall a. (a -> IsVoid) -> [a] -> ([a], [a])
    partition (IsVoid, FilteredHWType) -> IsVoid
    forall a b. (a, b) -> a
    fst [(IsVoid, FilteredHWType)]
    fields1
        = case [Text
    -> FilteredHWType
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goNoPort Text
    h FilteredHWType
    t | (Text
    h, (IsVoid
    False, FilteredHWType
    t)) <- [Text]
    -> [(IsVoid, FilteredHWType)] -> [(Text, (IsVoid, FilteredHWType))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    hints [(IsVoid, FilteredHWType)]
    fields1] of
            Either ExpandError (ExpandedPortName (Either Text Text))
    port:[Either ExpandError (ExpandedPortName (Either Text Text))]
    _ -> Either ExpandError (ExpandedPortName (Either Text Text))
    port
            [Either ExpandError (ExpandedPortName (Either Text Text))]
    _ -> [Char] -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error: insuffient ports"

        -- Product types (products, vec, rtree)
        | FilteredHWType -> IsVoid
    isProduct FilteredHWType
    fHwty
        , [[(IsVoid, FilteredHWType)]
    fields1] <- [[(IsVoid, FilteredHWType)]]
    fields0
        = Text
    -> HWType
    -> [ExpandedPortName (Either Text Text)]
    -> ExpandedPortName (Either Text Text)
    forall a.
    Text -> HWType -> [ExpandedPortName a] -> ExpandedPortName a
    ExpandedPortProduct Text
    hint HWType
    hwty1 ([ExpandedPortName (Either Text Text)]
     -> ExpandedPortName (Either Text Text))
    -> Either ExpandError [ExpandedPortName (Either Text Text)]
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            [Either ExpandError (ExpandedPortName (Either Text Text))]
    -> Either ExpandError [ExpandedPortName (Either Text Text)]
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence [Text
    -> FilteredHWType
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    goNoPort Text
    h FilteredHWType
    t | (Text
    h, (IsVoid
    False, FilteredHWType
    t)) <- [Text]
    -> [(IsVoid, FilteredHWType)] -> [(Text, (IsVoid, FilteredHWType))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    hints [(IsVoid, FilteredHWType)]
    fields1]

        -- All other types (sum of product, sum, "native")
        | IsVoid
    otherwise
        = ExpandedPortName (Either Text Text)
    -> Either ExpandError (ExpandedPortName (Either Text Text))
    forall a. a -> Either ExpandError a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Either Text Text -> ExpandedPortName (Either Text Text)
    forall a. HWType -> a -> ExpandedPortName a
    ExpandedPortName HWType
    hwty0 (Text -> Either Text Text
    forall a b. b -> Either a b
    Right Text
    hint))
       where
        ([Attr Text]
    attrs, HWType
    hwty1) = HWType -> ([Attr Text], HWType)
    stripAttributes HWType
    hwty0
        hints :: [Text]
    hints = (Int -> Text) -> [Int] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Int
    i -> Text
    hint Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showt Int
    i) [(Int
    0::Int)..]

    expandTopEntity [(Maybe Id, FilteredHWType)]
    _ (Maybe Id, FilteredHWType)
    _ Maybe TopEntity
    topEntityM =
      [Char] -> Either ExpandError (ExpandedTopEntity (Either Text Text))
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "expandTopEntity expects a Synthesize annotation, but got: " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Maybe TopEntity -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe TopEntity
    topEntityM)

    -- | Convert a Core 'C.Literal' to a Netlist v'HW.Literal'
    mkLiteral :: Int -- ^ int width
              -> C.Literal -> HW.Expr
    mkLiteral :: Int -> Literal -> Expr
    mkLiteral Int
    iw Literal
    lit = case Literal
    lit of
      C.IntegerLiteral Integer
    i -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Signed Int
    iw,Int
    iw)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    i
      C.IntLiteral Integer
    i     -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Signed Int
    iw,Int
    iw)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    i
      C.WordLiteral Integer
    w    -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    iw,Int
    iw)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    w
      C.Int64Literal Integer
    i   -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Signed Int
    64,Int
    64)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    i
      C.Word64Literal Integer
    w  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    64,Int
    64)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    w
    #if MIN_VERSION_ghc(8,8,0)
      C.Int8Literal Integer
    i    -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Signed Int
    8,Int
    8)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    i
      C.Int16Literal Integer
    i   -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Signed Int
    16,Int
    16)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    i
      C.Int32Literal Integer
    i   -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Signed Int
    32,Int
    32)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    i
      C.Word8Literal Integer
    w   -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    8,Int
    8)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    w
      C.Word16Literal Integer
    w  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    16,Int
    16)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    w
      C.Word32Literal Integer
    w  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    32,Int
    32)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    w
    #endif
      C.CharLiteral Char
    c    -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    21,Int
    21)) (Literal -> Expr) -> (Int -> Literal) -> Int -> Expr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 -> Expr) -> Int -> Expr
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c
      C.FloatLiteral Word32
    w   -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    BitVector Int
    32,Int
    32)) (Integer -> Literal
    NumLit (Integer -> Literal) -> Integer -> Literal
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger Word32
    w)
      C.DoubleLiteral Word64
    w  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    BitVector Int
    64,Int
    64)) (Integer -> Literal
    NumLit (Integer -> Literal) -> Integer -> Literal
    forall a b. (a -> b) -> a -> b
    $ Word64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger Word64
    w)
      C.NaturalLiteral Integer
    n -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    Unsigned Int
    iw,Int
    iw)) (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ Integer -> Literal
    NumLit Integer
    n
    #if MIN_VERSION_base(4,15,0)
      C.ByteArrayLiteral (ByteArray ByteArray#
    ba) -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Integer -> Literal
    NumLit (ByteArray# -> Integer
    IP ByteArray#
    ba))
    #else
      C.ByteArrayLiteral (ByteArray ba) -> HW.Literal Nothing (NumLit (Jp# (BN# ba)))
    #endif
      C.StringLiteral [Char]
    s  -> Maybe (HWType, Int) -> Literal -> Expr
    HW.Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Literal -> Expr) -> Literal -> Expr
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Literal
    StringLit [Char]
    s