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

    This module contains a mini dsl for creating haskell blackbox
    instantiations.
    -}

    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE LambdaCase        #-}
    {-# LANGUAGE NamedFieldPuns    #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE NamedFieldPuns    #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternSynonyms   #-}
    {-# LANGUAGE QuasiQuotes       #-}
    {-# LANGUAGE RecordWildCards   #-}
    {-# LANGUAGE TemplateHaskell   #-}
    {-# LANGUAGE TypeApplications  #-}
    {-# LANGUAGE ViewPatterns      #-}

    module Clash.Primitives.DSL
      (
      -- * Annotations
        BlackBoxHaskellOpts(..)
      , blackBoxHaskell

      -- * Declarations
      , BlockState (..)
      , TExpr(..)
      , addDeclaration
      , assign
      , compInBlock
      , declaration
      , declarationReturn
      , declare
      , declareN
      , instDecl
      , instHO
      , viaAnnotatedSignal

      -- ** Literals
      , bvLit
      , LitHDL (..)
      , pattern High
      , pattern Low
      , constructProduct
      , tuple
      , vec

      -- ** Extraction
      , tInputs
      , tResults
      , getStr
      , getBool
      , getVec
      , exprToInteger
      , tExprToInteger
      , deconstructProduct
      , untuple
      , unvec
      , deconstructMaybe

      -- ** Conversion
      , bitCoerce
      , toBV
      , toBvWithAttrs
      , fromBV
      , enableToBit
      , boolToBit
      , boolFromBit
      , boolFromBitVector
      , unsignedFromBitVector
      , boolFromBits

      , unsafeToActiveHigh
      , unsafeToActiveLow

      -- ** Operations
      , andExpr
      , notExpr
      , pureToBV
      , pureToBVResized
      , open

      -- ** Utilities
      , clog2
      , litTExpr
      , toIdentifier
      , tySize
      ) where

    import           Control.Lens                    hiding (Indexed, assign)
    #if MIN_VERSION_mtl(2,3,0)
    import           Control.Monad                   (forM, forM_, zipWithM)
    #endif
    import           Control.Monad.State
    import           Data.Default                    (Default(def))
    import           Data.IntMap                     (IntMap)
    import qualified Data.IntMap                     as IntMap
    import           Data.List                       (intersperse)
    import           Data.List.Extra                 (zipEqual)
    import           Data.Maybe                      (fromMaybe)
    import           Data.Monoid                     (Ap(getAp))
    import           Data.Semigroup                  hiding (Product)
    import           Data.String
    import           Data.Text                       (Text)
    import qualified Data.Text                       as Text
    import           Data.Text.Extra                 (showt)
    import           Data.Text.Prettyprint.Doc.Extra
    import           GHC.Stack                       (HasCallStack)

    import           Clash.Annotations.Primitive     (HDL (..), Primitive (..))
    import           Clash.Annotations.SynthesisAttributes (Attr)
    import           Clash.Backend                   hiding (Usage, fromBV, toBV)
    import           Clash.Backend.VHDL              (VHDLState)
    import           Clash.Explicit.Signal           (ResetPolarity(..), vResetPolarity)
    import           Clash.Netlist.BlackBox.Util     (exprToString, getDomainConf, renderElem)
    import           Clash.Netlist.BlackBox.Types
      (BlackBoxTemplate, Element(Component, Text), Decl(..))
    import qualified Clash.Netlist.Id                as Id
    import           Clash.Netlist.Types             hiding (Component, toBit)
    import           Clash.Netlist.Util
    import           Clash.Util                      (clogBase)
    import qualified Data.String.Interpolate         as I
    import           Language.Haskell.TH             (Name)
    import           Prelude

    -- | Options for 'blackBoxHaskell' function. Use 'def' from package
    -- 'data-default' for a set of default options.
    data BlackBoxHaskellOpts = BlackBoxHaskellOpts
      { -- | Arguments to ignore (i.e., remove during normalization)
        --
        -- Default: []
        BlackBoxHaskellOpts -> [Int]
    bo_ignoredArguments :: [Int]

        -- | HDLs to use the blackbox for
        --
        -- Default: all
      , BlackBoxHaskellOpts -> [HDL]
    bo_supportedHdls :: [HDL]

        -- | Does this blackbox assign its results to multiple binders?
        --
        -- Default: False.
      , BlackBoxHaskellOpts -> Bool
    bo_multiResult :: Bool
      }

    instance Default BlackBoxHaskellOpts where
      def :: BlackBoxHaskellOpts
    def = BlackBoxHaskellOpts
        { bo_ignoredArguments :: [Int]
    bo_ignoredArguments = []
        , bo_supportedHdls :: [HDL]
    bo_supportedHdls = [HDL
    forall a. Bounded a => a
    minBound..HDL
    forall a. Bounded a => a
    maxBound]
        , bo_multiResult :: Bool
    bo_multiResult = Bool
    False
        }

    -- | Create a blackBoxHaskell primitive. To be used as part of an annotation:
    --
    -- @
    -- {-\# ANN myFunction (blackBoxHaskell 'myFunction 'myBBF def{bo_ignoredArguments=[1,2]}) \#-}
    -- @
    --
    -- @[1,2]@ would mean this blackbox __ignores__ its second and third argument.
    blackBoxHaskell
      :: Name
      -- ^ blackbox name
      -> Name
      -- ^ template function name
      -> BlackBoxHaskellOpts
      -- ^ Options, see data structure for more information
      -> Primitive
    blackBoxHaskell :: Name -> Name -> BlackBoxHaskellOpts -> Primitive
    blackBoxHaskell Name
    bb Name
    tf BlackBoxHaskellOpts{Bool
    [Int]
    [HDL]
    bo_ignoredArguments :: BlackBoxHaskellOpts -> [Int]
    bo_supportedHdls :: BlackBoxHaskellOpts -> [HDL]
    bo_multiResult :: BlackBoxHaskellOpts -> Bool
    bo_ignoredArguments :: [Int]
    bo_supportedHdls :: [HDL]
    bo_multiResult :: Bool
    ..} =
      [HDL] -> String -> Primitive
    InlineYamlPrimitive [HDL]
    bo_supportedHdls [I.__i|
        BlackBoxHaskell:
          name: #{bb}
          templateFunction: #{tf}
          ignoredArguments : #{bo_ignoredArguments}
          multiResult : #{toYamlBool bo_multiResult}
        |]
     where
      toYamlBool :: Bool -> String
      toYamlBool :: Bool -> String
    toYamlBool Bool
    True = String
    "true"
      toYamlBool Bool
    False = String
    "false"

    -- | The state of a block. Contains a list of declarations and a the
    --   backend state.
    data BlockState backend = BlockState
      { forall backend. BlockState backend -> [Declaration]
    _bsDeclarations :: [Declaration]
        -- ^ Declarations store
      , forall backend. BlockState backend -> IntMap Int
    _bsHigherOrderCalls :: IntMap Int
        -- ^ Tracks how many times a higher order function has been instantiated.
        -- Needed to fill in the second field of 'Clash.Netlist.BlackBox.Types.Decl'
      , forall backend. BlockState backend -> backend
    _bsBackend :: backend
        -- ^ Backend state
      }
    makeLenses ''BlockState

    instance Backend backend => HasIdentifierSet (BlockState backend) where
      identifierSet :: Lens' (BlockState backend) IdentifierSet
      identifierSet :: Lens' (BlockState backend) IdentifierSet
    identifierSet = (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    forall backend backend (f :: Type -> Type).
    Functor f =>
    (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    bsBackend ((backend -> f backend)
     -> BlockState backend -> f (BlockState backend))
    -> ((IdentifierSet -> f IdentifierSet) -> backend -> f backend)
    -> (IdentifierSet -> f IdentifierSet)
    -> BlockState backend
    -> f (BlockState backend)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IdentifierSet -> f IdentifierSet) -> backend -> f backend
    forall s. HasIdentifierSet s => Lens' s IdentifierSet
    Lens' backend IdentifierSet
    identifierSet

    instance HasUsageMap backend => HasUsageMap (BlockState backend) where
      usageMap :: Lens' (BlockState backend) UsageMap
    usageMap = (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    forall backend backend (f :: Type -> Type).
    Functor f =>
    (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    bsBackend((backend -> f backend)
     -> BlockState backend -> f (BlockState backend))
    -> ((UsageMap -> f UsageMap) -> backend -> f backend)
    -> (UsageMap -> f UsageMap)
    -> BlockState backend
    -> f (BlockState backend)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(UsageMap -> f UsageMap) -> backend -> f backend
    forall s. HasUsageMap s => Lens' s UsageMap
    Lens' backend UsageMap
    usageMap

    liftToBlockState
      :: forall backend a. Backend backend
       => State backend a -> State (BlockState backend) a
    liftToBlockState :: forall backend a.
    Backend backend =>
    State backend a -> State (BlockState backend) a
    liftToBlockState (StateT backend -> Identity (a, backend)
    f) = (BlockState backend -> Identity (a, BlockState backend))
    -> StateT (BlockState backend) Identity a
    forall s (m :: Type -> Type) a. (s -> m (a, s)) -> StateT s m a
    StateT BlockState backend -> Identity (a, BlockState backend)
    g
     where
      g :: BlockState backend -> Identity (a, BlockState backend)
      g :: BlockState backend -> Identity (a, BlockState backend)
    g BlockState backend
    sbsIn = do
        let sIn :: backend
    sIn = BlockState backend -> backend
    forall backend. BlockState backend -> backend
    _bsBackend BlockState backend
    sbsIn
        (a
    res,backend
    sOut) <- backend -> Identity (a, backend)
    f backend
    sIn
        (a, BlockState backend) -> Identity (a, BlockState backend)
    forall a. a -> Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (a
    res, BlockState backend
    sbsIn{_bsBackend = sOut})

    -- | A typed expression.
    data TExpr = TExpr
      { TExpr -> HWType
    ety :: HWType
      , TExpr -> Expr
    eex :: Expr
      } deriving Int -> TExpr -> ShowS
    [TExpr] -> ShowS
    TExpr -> String
    (Int -> TExpr -> ShowS)
    -> (TExpr -> String) -> ([TExpr] -> ShowS) -> Show TExpr
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TExpr -> ShowS
    showsPrec :: Int -> TExpr -> ShowS
    $cshow :: TExpr -> String
    show :: TExpr -> String
    $cshowList :: [TExpr] -> ShowS
    showList :: [TExpr] -> ShowS
    Show
    makeLenses ''TExpr

    -- | Run a block declaration. Assign the result of the block builder to the
    -- result variable in the given blackbox context.
    declarationReturn
      :: Backend backend
      => BlackBoxContext
      -> Text.Text
      -- ^ block name
      -> State (BlockState backend) [TExpr]
      -- ^ block builder yielding an expression that should be assigned to the
      -- result variable in the blackbox context
      -> State backend Doc
      -- ^ pretty printed block
    declarationReturn :: forall backend.
    Backend backend =>
    BlackBoxContext
    -> Text -> State (BlockState backend) [TExpr] -> State backend Doc
    declarationReturn BlackBoxContext
    bbCtx Text
    blockName State (BlockState backend) [TExpr]
    blockBuilder =
      Text -> State (BlockState backend) () -> State backend Doc
    forall backend.
    Backend backend =>
    Text -> State (BlockState backend) () -> State backend Doc
    declaration Text
    blockName (State (BlockState backend) () -> State backend Doc)
    -> State (BlockState backend) () -> State backend Doc
    forall a b. (a -> b) -> a -> b
    $ do
        [TExpr]
    res <- State (BlockState backend) [TExpr]
    blockBuilder
        [((Expr, HWType), TExpr)]
    -> (((Expr, HWType), TExpr) -> State (BlockState backend) ())
    -> State (BlockState backend) ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([(Expr, HWType)] -> [TExpr] -> [((Expr, HWType), TExpr)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (BlackBoxContext -> [(Expr, HWType)]
    bbResults BlackBoxContext
    bbCtx) [TExpr]
    res) ((((Expr, HWType), TExpr) -> State (BlockState backend) ())
     -> State (BlockState backend) ())
    -> (((Expr, HWType), TExpr) -> State (BlockState backend) ())
    -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $ \((Expr, HWType)
    rNm, TExpr
    r) -> case (Expr, HWType)
    rNm of
          (Identifier Identifier
    resultNm Maybe Modifier
    Nothing, HWType
    _) ->
            Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    resultNm Usage
    Cont (TExpr -> Expr
    eex TExpr
    r))
          (Expr
    t,HWType
    _) -> String -> State (BlockState backend) ()
    forall a. HasCallStack => String -> a
    error (String
    "declarationReturn expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Expr -> String
    forall a. Show a => a -> String
    show Expr
    t)

    emptyBlockState :: backend -> BlockState backend
    emptyBlockState :: forall backend. backend -> BlockState backend
    emptyBlockState backend
    bck = BlockState
      { _bsDeclarations :: [Declaration]
    _bsDeclarations = []
      , _bsHigherOrderCalls :: IntMap Int
    _bsHigherOrderCalls = IntMap Int
    forall a. IntMap a
    IntMap.empty
      , _bsBackend :: backend
    _bsBackend = backend
    bck
      }

    -- | Run a block declaration.
    declaration
      :: Backend backend
      => Text.Text
      -- ^ block name
      -> State (BlockState backend) ()
      -- ^ block builder
      -> State backend Doc
      -- ^ pretty printed block
    declaration :: forall backend.
    Backend backend =>
    Text -> State (BlockState backend) () -> State backend Doc
    declaration Text
    blockName State (BlockState backend) ()
    c = do
      backend
    backend0 <- StateT backend Identity backend
    forall s (m :: Type -> Type). MonadState s m => m s
    get
      let initState :: BlockState backend
    initState = backend -> BlockState backend
    forall backend. backend -> BlockState backend
    emptyBlockState backend
    backend0
          (BlockState {backend
    [Declaration]
    IntMap Int
    _bsDeclarations :: forall backend. BlockState backend -> [Declaration]
    _bsHigherOrderCalls :: forall backend. BlockState backend -> IntMap Int
    _bsBackend :: forall backend. BlockState backend -> backend
    _bsDeclarations :: [Declaration]
    _bsHigherOrderCalls :: IntMap Int
    _bsBackend :: backend
    ..}) = State (BlockState backend) ()
    -> BlockState backend -> BlockState backend
    forall s a. State s a -> s -> s
    execState State (BlockState backend) ()
    c BlockState backend
    initState
      backend -> StateT backend Identity ()
    forall s (m :: Type -> Type). MonadState s m => s -> m ()
    put backend
    _bsBackend
      Identifier
    blockNameUnique <- Text -> StateT backend Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    blockName
      Ap (StateT backend Identity) Doc -> State backend Doc
    forall {k} (f :: k -> Type) (a :: k). Ap f a -> f a
    getAp (Ap (StateT backend Identity) Doc -> State backend Doc)
    -> Ap (StateT backend Identity) Doc -> State backend Doc
    forall a b. (a -> b) -> a -> b
    $ Identifier -> [Declaration] -> Ap (StateT backend Identity) Doc
    forall state.
    Backend state =>
    Identifier -> [Declaration] -> Ap (State state) Doc
    blockDecl Identifier
    blockNameUnique ([Declaration] -> [Declaration]
    forall a. [a] -> [a]
    reverse [Declaration]
    _bsDeclarations)

    -- | Add a declaration to the state.
    addDeclaration :: Declaration -> State (BlockState backend) ()
    addDeclaration :: forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration Declaration
    dec = ([Declaration] -> Identity [Declaration])
    -> BlockState backend -> Identity (BlockState backend)
    forall backend (f :: Type -> Type).
    Functor f =>
    ([Declaration] -> f [Declaration])
    -> BlockState backend -> f (BlockState backend)
    bsDeclarations (([Declaration] -> Identity [Declaration])
     -> BlockState backend -> Identity (BlockState backend))
    -> ([Declaration] -> [Declaration])
    -> StateT (BlockState backend) Identity ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= Declaration -> [Declaration] -> [Declaration]
    forall s a. Cons s s a a => a -> s -> s
    cons Declaration
    dec

    -- | Declare a new signal with the given name and type.
    declare'
      :: Backend backend
      => Text
      -- ^ Name hint
      -> HWType
      -- ^ Type of new signal
      -> State (BlockState backend) Identifier
      -- ^ Expression pointing the the new signal
    declare' :: forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) Identifier
    declare' Text
    decName HWType
    ty = do
      Identifier
    uniqueName <- Text -> State (BlockState backend) Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    decName
      Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    uniqueName HWType
    ty Maybe Expr
    forall a. Maybe a
    Nothing)
      Identifier -> State (BlockState backend) Identifier
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Identifier
    uniqueName

    -- | Declare a new signal with the given name and type.
    declare
      :: Backend backend
      => Text
      -- ^ Name hint
      -> HWType
      -- ^ Type of new signal
      -> State (BlockState backend) TExpr
      -- ^ Expression pointing the the new signal
    declare :: forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) TExpr
    declare Text
    decName HWType
    ty = do
      Identifier
    uniqueName <- Text -> HWType -> State (BlockState backend) Identifier
    forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) Identifier
    declare' Text
    decName HWType
    ty
      TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr HWType
    ty (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    uniqueName Maybe Modifier
    forall a. Maybe a
    Nothing))

    -- | Declare /n/ new signals with the given type and based on the given name
    declareN
      :: Backend backend
      => Text
      -- ^ Name hint
      -> [HWType]
      -- ^ Types of the signals
      -> State (BlockState backend) [TExpr]
      -- ^ Expressions pointing the the new signals
    declareN :: forall backend.
    Backend backend =>
    Text -> [HWType] -> State (BlockState backend) [TExpr]
    declareN Text
    decName [HWType]
    tys = do
      Identifier
    firstName <- Text -> StateT (BlockState backend) Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    decName
      [Identifier]
    nextNames <- Int
    -> Identifier -> StateT (BlockState backend) Identity [Identifier]
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Int -> Identifier -> m [Identifier]
    Id.nextN ([HWType] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [HWType]
    tys Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Identifier
    firstName
      let uniqueNames :: [Identifier]
    uniqueNames = Identifier
    firstName Identifier -> [Identifier] -> [Identifier]
    forall a. a -> [a] -> [a]
    : [Identifier]
    nextNames
      (Identifier
     -> HWType -> StateT (BlockState backend) Identity TExpr)
    -> [Identifier] -> [HWType] -> State (BlockState backend) [TExpr]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM
        (\Identifier
    uniqueName HWType
    ty -> do
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Declaration -> State (BlockState backend) ())
    -> Declaration -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $ Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
    NetDecl' Maybe Text
    forall a. Maybe a
    Nothing Identifier
    uniqueName HWType
    ty Maybe Expr
    forall a. Maybe a
    Nothing
          TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (TExpr -> StateT (BlockState backend) Identity TExpr)
    -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall a b. (a -> b) -> a -> b
    $ HWType -> Expr -> TExpr
    TExpr HWType
    ty (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    uniqueName Maybe Modifier
    forall a. Maybe a
    Nothing)
        ) [Identifier]
    uniqueNames [HWType]
    tys

    -- | Assign an expression to an identifier, returns the new typed
    --   identifier expression.
    assign
      :: Backend backend
      => Text
      -- ^ Name hint for assignment
      -> TExpr
      -- ^ expression to be assigned to freshly generated identifier
      -> State (BlockState backend) TExpr
      -- ^ the identifier of the expression that actually got assigned
    assign :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    aName (TExpr HWType
    ty Expr
    aExpr) = do
      TExpr
    texp <- Text -> HWType -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) TExpr
    declare Text
    aName HWType
    ty
      let uniqueName :: Identifier
    uniqueName = case TExpr
    texp of
            TExpr HWType
    _ (Identifier Identifier
    x Maybe Modifier
    Nothing) -> Identifier
    x
            TExpr
    t' -> String -> Identifier
    forall a. HasCallStack => String -> a
    error (String
    "assign expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    t')

      Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    uniqueName Usage
    Cont Expr
    aExpr)
      TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    texp

    -- | Extract the elements of a vector expression and return expressions
    -- to them. If given expression is not an identifier, an intermediate variable
    -- will be used to assign the given expression to which is subsequently indexed.
    unvec
      :: (HasCallStack, Backend backend)
      => Text
      -- ^ Name hint for intermediate signal
      -> TExpr
      -- ^ Vector expression
      -> State (BlockState backend) [TExpr]
      -- ^ Vector elements
    unvec :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> TExpr -> State (BlockState backend) [TExpr]
    unvec Text
    vName v :: TExpr
    v@(TExpr -> HWType
    ety -> Vector Int
    vSize HWType
    eType) = do
      TExpr
    texp <- Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toIdentifier Text
    vName TExpr
    v
      let vUniqueName :: Identifier
    vUniqueName = case TExpr
    texp of
            TExpr HWType
    _ (Identifier Identifier
    x Maybe Modifier
    Nothing) -> Identifier
    x
            TExpr
    t' -> String -> Identifier
    forall a. HasCallStack => String -> a
    error (String
    "unvec expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    t')

      let vIndex :: Int -> Expr
    vIndex Int
    i = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    vUniqueName (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (TExpr -> HWType
    ety TExpr
    v, Int
    10, Int
    i)))
      [TExpr] -> State (BlockState backend) [TExpr]
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ((Int -> TExpr) -> [Int] -> [TExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (HWType -> Expr -> TExpr
    TExpr HWType
    eType (Expr -> TExpr) -> (Int -> Expr) -> Int -> TExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Expr
    vIndex) [Int
    0..Int
    vSizeInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1])
    unvec Text
    _ TExpr
    e = String -> State (BlockState backend) [TExpr]
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) [TExpr])
    -> String -> State (BlockState backend) [TExpr]
    forall a b. (a -> b) -> a -> b
    $ String
    "unvec: cannot be called on non-vector: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> HWType -> String
    forall a. Show a => a -> String
    show (TExpr -> HWType
    ety TExpr
    e)

    -- | Deconstruct a 'Maybe' into its constructor 'Bit' and contents of its 'Just'
    -- field. Note that the contents might be undefined, if the constructor bit is
    -- set to 'Nothing'.
    deconstructMaybe ::
      (HasCallStack, Backend backend) =>
      -- | Maybe expression
      TExpr ->
      -- | Name hint for constructor bit, data
      (Text, Text) ->
      -- | Constructor represented as a Bit, contents of Just
      State (BlockState backend) (TExpr, TExpr)
    deconstructMaybe :: forall backend.
    (HasCallStack, Backend backend) =>
    TExpr -> (Text, Text) -> State (BlockState backend) (TExpr, TExpr)
    deconstructMaybe e :: TExpr
    e@TExpr{HWType
    ety :: TExpr -> HWType
    ety :: HWType
    ety} (Text
    bitName, Text
    contentName)
      | SP Text
    tyName [(Text
    _nothing, []),(Text
    _just, [HWType
    aTy])] <- HWType
    ety
      , Text
    tyName Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Text
    forall a. IsString a => String -> a
    fromString (Name -> String
    forall a. Show a => a -> String
    show ''Maybe)
      = do
        TExpr
    eBv <- Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toBV (Text
    bitName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_and_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    contentName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_bv") TExpr
    e
        Identifier
    eId <- Text -> TExpr -> State (BlockState backend) Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' (Text
    bitName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_and_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    contentName) TExpr
    eBv
        let eSize :: Int
    eSize = HWType -> Int
    typeSize HWType
    ety

        TExpr
    bitExpr <- Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    fromBV Text
    bitName HWType
    Bit TExpr
          { eex :: Expr
    eex = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    eId (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Sliced (Int -> HWType
    BitVector Int
    eSize, Int
    eSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    eSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)))
          , ety :: HWType
    ety = Int -> HWType
    BitVector Int
    1
          }

        TExpr
    contentExpr <- Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    fromBV Text
    contentName HWType
    aTy TExpr
          { eex :: Expr
    eex = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    eId (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Sliced (Int -> HWType
    BitVector Int
    eSize, Int
    eSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    0)))
          , ety :: HWType
    ety = Int -> HWType
    BitVector (Int
    eSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
          }

        (TExpr, TExpr) -> State (BlockState backend) (TExpr, TExpr)
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (TExpr
    bitExpr, TExpr
    contentExpr)

    deconstructMaybe TExpr
    e (Text, Text)
    _ =
      String -> State (BlockState backend) (TExpr, TExpr)
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) (TExpr, TExpr))
    -> String -> State (BlockState backend) (TExpr, TExpr)
    forall a b. (a -> b) -> a -> b
    $ String
    "deconstructMaybe: cannot be called on non-Maybe: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> HWType -> String
    forall a. Show a => a -> String
    show (TExpr -> HWType
    ety TExpr
    e)

    -- | Extract the fields of a product type and return expressions
    --   to them. These new expressions are given unique names and get
    --   declared in the block scope.
    deconstructProduct
      :: (HasCallStack, Backend backend)
      => TExpr
      -- ^ Product expression
      -> [Text]
      -- ^ Name hints for element assignments
      -> State (BlockState backend) [TExpr]
    deconstructProduct :: forall backend.
    (HasCallStack, Backend backend) =>
    TExpr -> [Text] -> State (BlockState backend) [TExpr]
    deconstructProduct (TExpr ty :: HWType
    ty@(Product Text
    _ Maybe [Text]
    _ [HWType]
    fieldTys) (Identifier Identifier
    resName Maybe Modifier
    Nothing)) [Text]
    nameHints =
      [(Int, Text, HWType)]
    -> ((Int, Text, HWType)
        -> StateT (BlockState backend) Identity TExpr)
    -> StateT (BlockState backend) Identity [TExpr]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM ([Int] -> [Text] -> [HWType] -> [(Int, Text, HWType)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Int
    0..] [Text]
    nameHints [HWType]
    fieldTys) (((Int, Text, HWType)
      -> StateT (BlockState backend) Identity TExpr)
     -> StateT (BlockState backend) Identity [TExpr])
    -> ((Int, Text, HWType)
        -> StateT (BlockState backend) Identity TExpr)
    -> StateT (BlockState backend) Identity [TExpr]
    forall a b. (a -> b) -> a -> b
    $ \(Int
    fieldIndex, Text
    nameHint, HWType
    fieldTy) ->
        Text -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    nameHint (TExpr -> StateT (BlockState backend) Identity TExpr)
    -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall a b. (a -> b) -> a -> b
    $
          HWType -> Expr -> TExpr
    TExpr HWType
    fieldTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    resName (Modifier -> Maybe Modifier
    forall a. a -> Maybe a
    Just ((HWType, Int, Int) -> Modifier
    Indexed (HWType
    ty, Int
    0, Int
    fieldIndex))))

    deconstructProduct t0 :: TExpr
    t0@(TExpr (Product {}) Expr
    _) [Text]
    nameHints = do
      TExpr
    t1 <- Text -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toIdentifier Text
    "product" TExpr
    t0
      TExpr -> [Text] -> StateT (BlockState backend) Identity [TExpr]
    forall backend.
    (HasCallStack, Backend backend) =>
    TExpr -> [Text] -> State (BlockState backend) [TExpr]
    deconstructProduct TExpr
    t1 [Text]
    nameHints

    deconstructProduct TExpr
    e [Text]
    i =
      String -> StateT (BlockState backend) Identity [TExpr]
    forall a. HasCallStack => String -> a
    error (String -> StateT (BlockState backend) Identity [TExpr])
    -> String -> StateT (BlockState backend) Identity [TExpr]
    forall a b. (a -> b) -> a -> b
    $ String
    "deconstructProduct: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    e String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> String
    forall a. Show a => a -> String
    show [Text]
    i

    -- | Extract the elements of a tuple expression and return expressions
    --   to them. These new expressions are given unique names and get
    --   declared in the block scope.
    untuple
      :: (HasCallStack, Backend backend)
      => TExpr
      -- ^ Tuple expression
      -> [Text]
      -- ^ Name hints for element assignments
      -> State (BlockState backend) [TExpr]
    untuple :: forall backend.
    (HasCallStack, Backend backend) =>
    TExpr -> [Text] -> State (BlockState backend) [TExpr]
    untuple = TExpr -> [Text] -> State (BlockState backend) [TExpr]
    forall backend.
    (HasCallStack, Backend backend) =>
    TExpr -> [Text] -> State (BlockState backend) [TExpr]
    deconstructProduct

    -- | The high literal bit.
    pattern High :: TExpr
    pattern $mHigh :: forall {r}. TExpr -> ((# #) -> r) -> ((# #) -> r) -> r
    $bHigh :: TExpr
    High <- TExpr Bit (Literal _ (BitLit H))
      where High = HWType -> Expr -> TExpr
    TExpr HWType
    Bit (Maybe (HWType, Int) -> Literal -> Expr
    Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (HWType
    Bit,Int
    1)) (Bit -> Literal
    BitLit Bit
    H))

    -- | The low literal bit.
    pattern Low :: TExpr
    pattern $mLow :: forall {r}. TExpr -> ((# #) -> r) -> ((# #) -> r) -> r
    $bLow :: TExpr
    Low <- TExpr Bit (Literal _ (BitLit L))
      where Low = HWType -> Expr -> TExpr
    TExpr HWType
    Bit (Maybe (HWType, Int) -> Literal -> Expr
    Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (HWType
    Bit,Int
    1)) (Bit -> Literal
    BitLit Bit
    L))

    -- | The true literal bool.
    pattern T :: TExpr
    pattern $mT :: forall {r}. TExpr -> ((# #) -> r) -> ((# #) -> r) -> r
    $bT :: TExpr
    T <- TExpr Bool (Literal _ (BoolLit True))
      where T = HWType -> Expr -> TExpr
    TExpr HWType
    Bool (Maybe (HWType, Int) -> Literal -> Expr
    Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (HWType
    Bool,Int
    1)) (Bool -> Literal
    BoolLit Bool
    True))

    -- | The false literal bool.
    pattern F :: TExpr
    pattern $mF :: forall {r}. TExpr -> ((# #) -> r) -> ((# #) -> r) -> r
    $bF :: TExpr
    F <- TExpr Bool (Literal _ (BoolLit False))
      where F = HWType -> Expr -> TExpr
    TExpr HWType
    Bool (Maybe (HWType, Int) -> Literal -> Expr
    Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (HWType
    Bool,Int
    1)) (Bool -> Literal
    BoolLit Bool
    False))

    -- | Construct a fully defined BitVector literal
    bvLit
      :: Int
      -- ^ BitVector size
      -> Integer
      -- ^ Literal
      -> TExpr
    bvLit :: Int -> Integer -> TExpr
    bvLit Int
    sz Integer
    n =
      HWType -> Expr -> TExpr
    TExpr
        (Int -> HWType
    BitVector Int
    sz)
        (Maybe (HWType, Int) -> Literal -> Expr
    Literal ((HWType, Int) -> Maybe (HWType, Int)
    forall a. a -> Maybe a
    Just (Int -> HWType
    BitVector Int
    sz, Int
    sz)) (Integer -> Integer -> Literal
    BitVecLit Integer
    0 Integer
    n))

    -- | Convert a bool to a bit.
    boolToBit
      :: (HasCallStack, Backend backend)
      => Text
      -- ^ Name hint for intermediate signal
      -> TExpr
      -> State (BlockState backend) TExpr
    boolToBit :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> TExpr -> State (BlockState backend) TExpr
    boolToBit Text
    bitName = \case
      TExpr
    T -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    High
      TExpr
    F -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    Low
      TExpr HWType
    Bool Expr
    boolExpr -> do
        TExpr
    texp <- Text -> HWType -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) TExpr
    declare Text
    bitName HWType
    Bit
        let uniqueBitName :: Identifier
    uniqueBitName = case TExpr
    texp of
              TExpr HWType
    _ (Identifier Identifier
    x Maybe Modifier
    Nothing) -> Identifier
    x
              TExpr
    t' -> String -> Identifier
    forall a. HasCallStack => String -> a
    error (String
    "boolFromBit expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    t')
        Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Declaration -> State (BlockState backend) ())
    -> Declaration -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $
          Identifier
    -> HWType
    -> Expr
    -> HWType
    -> [(Maybe Literal, Expr)]
    -> Declaration
    CondAssignment Identifier
    uniqueBitName HWType
    Bit Expr
    boolExpr HWType
    Bool
            [ (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Bool -> Literal
    BoolLit Bool
    True), Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bit -> Literal
    BitLit Bit
    H))
            , (Maybe Literal
    forall a. Maybe a
    Nothing            , Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bit -> Literal
    BitLit Bit
    L))
            ]
        Usage -> Identifier -> State (BlockState backend) ()
    forall s. HasUsageMap s => Usage -> Identifier -> State s ()
    declareUseOnce (Blocking -> Usage
    Proc Blocking
    NonBlocking) Identifier
    uniqueBitName
        TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    texp
      TExpr
    tExpr -> String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) TExpr)
    -> String -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "boolToBit: Got \"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    tExpr String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "\" expected Bool"

    -- | Convert an enable to a bit.
    enableToBit
      :: (HasCallStack, Backend backend)
      => Text
      -- ^ Name hint for intermediate signal
      -> TExpr
      -> State (BlockState backend) TExpr
    enableToBit :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> TExpr -> State (BlockState backend) TExpr
    enableToBit Text
    bitName = \case
      TExpr ena :: HWType
    ena@(Enable Text
    _) Expr
    enableExpr -> do
        TExpr
    texp <- Text -> HWType -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) TExpr
    declare Text
    bitName HWType
    Bit
        let uniqueBitName :: Identifier
    uniqueBitName = case TExpr
    texp of
              TExpr HWType
    _ (Identifier Identifier
    x Maybe Modifier
    Nothing) -> Identifier
    x
              TExpr
    t' -> String -> Identifier
    forall a. HasCallStack => String -> a
    error (String
    "boolFromBit expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    t')
        Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Declaration -> State (BlockState backend) ())
    -> Declaration -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $
          Identifier
    -> HWType
    -> Expr
    -> HWType
    -> [(Maybe Literal, Expr)]
    -> Declaration
    CondAssignment Identifier
    uniqueBitName HWType
    Bit Expr
    enableExpr HWType
    ena
            -- Enable normalizes to Bool for all current backends
            [ (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Bool -> Literal
    BoolLit Bool
    True), Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bit -> Literal
    BitLit Bit
    H))
            , (Maybe Literal
    forall a. Maybe a
    Nothing            , Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bit -> Literal
    BitLit Bit
    L))
            ]
        Usage -> Identifier -> State (BlockState backend) ()
    forall s. HasUsageMap s => Usage -> Identifier -> State s ()
    declareUseOnce (Blocking -> Usage
    Proc Blocking
    NonBlocking) Identifier
    uniqueBitName
        TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    texp
      TExpr
    tExpr -> String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) TExpr)
    -> String -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "enableToBit: Got \"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    tExpr String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "\" expected Enable"

    -- | Use to create an output `Bool` from a `Bit`. The expression given
    --   must be the identifier of the bool you wish to get assigned.
    --   Returns a reference to a declared `Bit` that should get assigned
    --   by something (usually the output port of an entity).
    boolFromBit
      :: (HasCallStack, Backend backend)
      => Text
      -- ^ Name hint for intermediate signal
      -> TExpr
      -> State (BlockState backend) TExpr
    boolFromBit :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> TExpr -> State (BlockState backend) TExpr
    boolFromBit Text
    boolName = \case
      TExpr
    High -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    T
      TExpr
    Low -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    F
      TExpr HWType
    Bit Expr
    bitExpr -> do
        TExpr
    texp <- Text -> HWType -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) TExpr
    declare Text
    boolName HWType
    Bool
        let uniqueBoolName :: Identifier
    uniqueBoolName = case TExpr
    texp of
              TExpr HWType
    _ (Identifier Identifier
    x Maybe Modifier
    Nothing) -> Identifier
    x
              TExpr
    t' -> String -> Identifier
    forall a. HasCallStack => String -> a
    error (String
    "boolFromBit expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    t')
        Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Declaration -> State (BlockState backend) ())
    -> Declaration -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $
          Identifier
    -> HWType
    -> Expr
    -> HWType
    -> [(Maybe Literal, Expr)]
    -> Declaration
    CondAssignment Identifier
    uniqueBoolName HWType
    Bool Expr
    bitExpr HWType
    Bit
            [ (Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just (Bit -> Literal
    BitLit Bit
    H), Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bool -> Literal
    BoolLit Bool
    True))
            , (Maybe Literal
    forall a. Maybe a
    Nothing        , Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bool -> Literal
    BoolLit Bool
    False))
            ]
        Usage -> Identifier -> State (BlockState backend) ()
    forall s. HasUsageMap s => Usage -> Identifier -> State s ()
    declareUseOnce (Blocking -> Usage
    Proc Blocking
    NonBlocking) Identifier
    uniqueBoolName
        TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    texp
      TExpr
    tExpr -> String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) TExpr)
    -> String -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "boolFromBit: Got \"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    tExpr String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "\" expected Bit"

    -- | Used to create an output `Bool` from a `BitVector` of given size.
    -- Works in a similar way to `boolFromBit` above.
    --
    -- TODO: Implement for (System)Verilog
    boolFromBitVector
      :: Size
      -> Text
      -- ^ Name hint for intermediate signal
      -> TExpr
      -> State (BlockState VHDLState) TExpr
    boolFromBitVector :: Int -> Text -> TExpr -> State (BlockState VHDLState) TExpr
    boolFromBitVector Int
    n =
      HWType
    -> HWType
    -> (Text -> Text)
    -> Text
    -> TExpr
    -> State (BlockState VHDLState) TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    HWType
    -> HWType
    -> (Text -> Text)
    -> Text
    -> TExpr
    -> State (BlockState backend) TExpr
    outputCoerce (Int -> HWType
    BitVector Int
    n) HWType
    Bool (\Text
    i -> Text
    "unsigned(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ") > 0")

    -- | Used to create an output `Unsigned` from a `BitVector` of given
    -- size. Works in a similar way to `boolFromBit` above.
    unsignedFromBitVector ::
      (HasCallStack, Backend backend) =>
      -- | Name hint for intermediate signal
      Text ->
      -- | BitVector expression
      TExpr ->
      -- | Unsigned expression
      State (BlockState backend) TExpr
    unsignedFromBitVector :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> TExpr -> State (BlockState backend) TExpr
    unsignedFromBitVector Text
    nameHint e :: TExpr
    e@TExpr{ety :: TExpr -> HWType
    ety=BitVector Int
    n} =
      Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    fromBV Text
    nameHint (Int -> HWType
    Unsigned Int
    n) TExpr
    e
    unsignedFromBitVector Text
    _nameHint TExpr{HWType
    ety :: TExpr -> HWType
    ety :: HWType
    ety} =
      String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) TExpr)
    -> String -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "unsignedFromBitVector: Expected BitVector, got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> HWType -> String
    forall a. Show a => a -> String
    show HWType
    ety

    -- | Used to create an output `Bool` from a number of `Bit`s, using
    -- conjunction. Similarly to `untuple`, it returns a list of
    -- references to declared values (the inputs to the function) which
    -- should get assigned by something---usually output ports of an
    -- entity.
    --
    -- TODO: Implement for (System)Verilog
    boolFromBits
      :: [Text]
      -> TExpr
      -> State (BlockState VHDLState) [TExpr]
    boolFromBits :: [Text] -> TExpr -> State (BlockState VHDLState) [TExpr]
    boolFromBits [Text]
    inNames = [HWType]
    -> HWType
    -> ([Text] -> Text)
    -> [Text]
    -> TExpr
    -> State (BlockState VHDLState) [TExpr]
    forall backend.
    (HasCallStack, Backend backend) =>
    [HWType]
    -> HWType
    -> ([Text] -> Text)
    -> [Text]
    -> TExpr
    -> State (BlockState backend) [TExpr]
    outputFn ((Text -> HWType) -> [Text] -> [HWType]
    forall a b. (a -> b) -> [a] -> [b]
    map (HWType -> Text -> HWType
    forall a b. a -> b -> a
    const HWType
    Bit) [Text]
    inNames) HWType
    Bool
      ((Text -> Text -> Text) -> Text -> [Text] -> Text
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    (<>) Text
    "" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    intersperse Text
    " and " ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Text
    i -> Text
    "(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = '1')")) [Text]
    inNames

    -- | Used to create an output value with an arbitrary VHDL coercion.
    -- The expression given should be the identifier of the output value
    -- you wish to get assigned. Returns a reference to a declared value
    -- of the input type that should get assigned by something (usually
    -- the output port of an entity).
    outputCoerce
      :: (HasCallStack, Backend backend)
      => HWType
      -> HWType
      -> (Text -> Text)
      -> Text
      -> TExpr
      -> State (BlockState backend) TExpr
    outputCoerce :: forall backend.
    (HasCallStack, Backend backend) =>
    HWType
    -> HWType
    -> (Text -> Text)
    -> Text
    -> TExpr
    -> State (BlockState backend) TExpr
    outputCoerce HWType
    fromType HWType
    toType Text -> Text
    exprStringFn Text
    inName0 TExpr
    expr_
      | TExpr HWType
    outType (Identifier Identifier
    outName Maybe Modifier
    Nothing) <- TExpr
    expr_
      , HWType
    outType HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HWType
    toType = do
          Identifier
    inName1 <- Text -> StateT (BlockState backend) Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic Text
    inName0
          let inName2 :: Identifier
    inName2 = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake (Text -> Text
    exprStringFn (Identifier -> Text
    Id.toText Identifier
    inName1))
              exprIdent :: Expr
    exprIdent = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    inName2 Maybe Modifier
    forall a. Maybe a
    Nothing
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Maybe Text -> Identifier -> HWType -> Declaration
    NetDecl Maybe Text
    forall a. Maybe a
    Nothing Identifier
    inName1 HWType
    fromType)
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    outName Usage
    Cont Expr
    exprIdent)
          TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr HWType
    fromType (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    inName1 Maybe Modifier
    forall a. Maybe a
    Nothing))
    outputCoerce HWType
    _ HWType
    toType Text -> Text
    _ Text
    _ TExpr
    texpr = String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) TExpr)
    -> String -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "outputCoerce: the expression " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    texpr
                                      String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " must be an Identifier with type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> HWType -> String
    forall a. Show a => a -> String
    show HWType
    toType

    -- | Used to create an output value that is an arbitrary function (as
    -- VHDL) of existing values. The expression given should be the
    -- identifier of the output value you wish to get assigned. Similarly
    -- to `untuple`, it returns a list of references to declared values
    -- (the inputs to the function) which should get assigned by
    -- something---usually output ports of an entity.
    outputFn
      :: (HasCallStack, Backend backend)
      => [HWType]
      -> HWType
      -> ([Text] -> Text)
      -> [Text]
      -> TExpr
      -> State (BlockState backend) [TExpr]
    outputFn :: forall backend.
    (HasCallStack, Backend backend) =>
    [HWType]
    -> HWType
    -> ([Text] -> Text)
    -> [Text]
    -> TExpr
    -> State (BlockState backend) [TExpr]
    outputFn [HWType]
    fromTypes HWType
    toType [Text] -> Text
    exprFn [Text]
    inNames0 (TExpr HWType
    outType (Identifier Identifier
    outName Maybe Modifier
    Nothing))
      | HWType
    outType HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HWType
    toType = do
          [Identifier]
    inNames1 <- (Text -> StateT (BlockState backend) Identity Identifier)
    -> [Text] -> StateT (BlockState backend) Identity [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 Text -> StateT (BlockState backend) Identity Identifier
    forall (m :: Type -> Type).
    (HasCallStack, IdentifierSetMonad m) =>
    Text -> m Identifier
    Id.makeBasic [Text]
    inNames0
          let idExpr :: Identifier
    idExpr = HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake ([Text] -> Text
    exprFn ((Identifier -> Text) -> [Identifier] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Identifier -> Text
    Id.toText [Identifier]
    inNames1))
              exprIdent :: Expr
    exprIdent = Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    idExpr Maybe Modifier
    forall a. Maybe a
    Nothing
          Getting
      (Sequenced () (StateT (BlockState backend) Identity))
      [State (BlockState backend) ()]
      (State (BlockState backend) ())
    -> [State (BlockState backend) ()] -> State (BlockState backend) ()
    forall (m :: Type -> Type) a s.
    Monad m =>
    Getting (Sequenced a m) s (m a) -> s -> m ()
    sequenceOf_ Getting
      (Sequenced () (StateT (BlockState backend) Identity))
      [State (BlockState backend) ()]
      (State (BlockState backend) ())
    forall s t a b. Each s t a b => Traversal s t a b
    Traversal
      [State (BlockState backend) ()]
      [State (BlockState backend) ()]
      (State (BlockState backend) ())
      (State (BlockState backend) ())
    each [ Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Maybe Text -> Identifier -> HWType -> Declaration
    NetDecl Maybe Text
    forall a. Maybe a
    Nothing Identifier
    nm HWType
    t)
                           | (Identifier
    nm, HWType
    t) <- [Identifier] -> [HWType] -> [(Identifier, HWType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Identifier]
    inNames1 [HWType]
    fromTypes ]
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    outName Usage
    Cont Expr
    exprIdent)
          [TExpr] -> State (BlockState backend) [TExpr]
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [ HWType -> Expr -> TExpr
    TExpr HWType
    t (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    nm Maybe Modifier
    forall a. Maybe a
    Nothing)
               | (Identifier
    nm,HWType
    t) <- [Identifier] -> [HWType] -> [(Identifier, HWType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zipEqual [Identifier]
    inNames1 [HWType]
    fromTypes ]
    outputFn [HWType]
    _ HWType
    outType [Text] -> Text
    _ [Text]
    _ TExpr
    texpr =
      String -> State (BlockState backend) [TExpr]
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) [TExpr])
    -> String -> State (BlockState backend) [TExpr]
    forall a b. (a -> b) -> a -> b
    $ String
    "outputFn: the expression " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    texpr
      String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " must be an Identifier with type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> HWType -> String
    forall a. Show a => a -> String
    show HWType
    outType

    -- | Create a vector of 'TExpr's
    vec
      :: (HasCallStack, Backend backend)
      => [TExpr]
      -- ^ Elements of vector
      -> State (BlockState backend) TExpr
      -- ^ Vector elements
    vec :: forall backend.
    (HasCallStack, Backend backend) =>
    [TExpr] -> State (BlockState backend) TExpr
    vec els :: [TExpr]
    els@(TExpr
    el:[TExpr]
    _)
      | (TExpr -> Bool) -> [TExpr] -> Bool
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Bool
    all (\TExpr
    e -> TExpr -> HWType
    ety TExpr
    e HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    == TExpr -> HWType
    ety TExpr
    el) [TExpr]
    els
      = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr (Int -> HWType -> HWType
    Vector ([TExpr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [TExpr]
    els) (TExpr -> HWType
    ety TExpr
    el)) Expr
    theVec)
      | Bool
    otherwise
      = String -> StateT (BlockState backend) Identity TExpr
    forall a. HasCallStack => String -> a
    error (String -> StateT (BlockState backend) Identity TExpr)
    -> String -> StateT (BlockState backend) Identity TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "vec: elements not of same type: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [TExpr] -> String
    forall a. Show a => a -> String
    show [TExpr]
    els
     where
      theVec :: Expr
    theVec = Int -> HWType -> [Expr] -> Expr
    mkVectorChain ([TExpr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [TExpr]
    els) (TExpr -> HWType
    ety TExpr
    el) ((TExpr -> Expr) -> [TExpr] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map TExpr -> Expr
    eex [TExpr]
    els)
    vec [] = String -> StateT (BlockState backend) Identity TExpr
    forall a. HasCallStack => String -> a
    error String
    "vec: can't be used on empty lists"

    -- | Construct a product type given its type and fields
    constructProduct :: HWType -> [TExpr] -> TExpr
    constructProduct :: HWType -> [TExpr] -> TExpr
    constructProduct HWType
    ty [TExpr]
    els =
      HWType -> Expr -> TExpr
    TExpr HWType
    ty (HWType -> Modifier -> [Expr] -> Expr
    DataCon HWType
    ty ((HWType, Int) -> Modifier
    DC (HWType
    ty,Int
    0)) ((TExpr -> Expr) -> [TExpr] -> [Expr]
    forall a b. (a -> b) -> [a] -> [b]
    map TExpr -> Expr
    eex [TExpr]
    els))

    -- | Create an n-tuple of 'TExpr'
    tuple :: HasCallStack => [TExpr] -> TExpr
    tuple :: HasCallStack => [TExpr] -> TExpr
    tuple [] = String -> TExpr
    forall a. HasCallStack => String -> a
    error (String -> TExpr) -> String -> TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "nTuple: Cannot create empty tuple"
    tuple [TExpr
    _] =
      -- If we don't put this in: tuple . untuple /= id
      String -> TExpr
    forall a. HasCallStack => String -> a
    error (String -> TExpr) -> String -> TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "nTuple: Cannot create 1-tuple"
    tuple [TExpr]
    els = HWType -> [TExpr] -> TExpr
    constructProduct HWType
    tupTy [TExpr]
    els
     where
      commas :: Text
    commas = Int -> Text -> Text
    Text.replicate ([TExpr] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [TExpr]
    els Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Text
    ","
      tupTy :: HWType
    tupTy = Text -> Maybe [Text] -> [HWType] -> HWType
    Product (Text
    "GHC.Tuple.(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    commas Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")") Maybe [Text]
    forall a. Maybe a
    Nothing ((TExpr -> HWType) -> [TExpr] -> [HWType]
    forall a b. (a -> b) -> [a] -> [b]
    map TExpr -> HWType
    ety [TExpr]
    els)

    -- | Try to get the literal string value of an expression.
    getStr :: TExpr -> Maybe String
    getStr :: TExpr -> Maybe String
    getStr (TExpr HWType
    _ Expr
    e) = Expr -> Maybe String
    exprToString Expr
    e

    -- | Try to get the literal bool value of an expression.
    getBool :: TExpr -> Maybe Bool
    getBool :: TExpr -> Maybe Bool
    getBool (TExpr HWType
    _ (Literal Maybe (HWType, Int)
    _ (BoolLit Bool
    b))) = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    b
    getBool TExpr
    _ = Maybe Bool
    forall a. Maybe a
    Nothing

    -- | Try to get a Vector of expressions.
    getVec :: TExpr -> Maybe [TExpr]
    getVec :: TExpr -> Maybe [TExpr]
    getVec (TExpr (Void (Just (Vector Int
    0 HWType
    _) )) Expr
    _) =
      [TExpr] -> Maybe [TExpr]
    forall a. a -> Maybe a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
    getVec (TExpr (Vector Int
    1 HWType
    elementTy) (DataCon HWType
    _ Modifier
    VecAppend [Expr
    e])) =
      [TExpr] -> Maybe [TExpr]
    forall a. a -> Maybe a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure [HWType -> Expr -> TExpr
    TExpr HWType
    elementTy Expr
    e]
    getVec (TExpr (Vector Int
    n HWType
    elementTy) (DataCon HWType
    _ Modifier
    VecAppend [Expr
    e, Expr
    es0])) = do
      [TExpr]
    es1 <- TExpr -> Maybe [TExpr]
    getVec (HWType -> Expr -> TExpr
    TExpr (Int -> HWType -> HWType
    Vector (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) HWType
    elementTy) Expr
    es0)
      [TExpr] -> Maybe [TExpr]
    forall a. a -> Maybe a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr HWType
    elementTy Expr
    eTExpr -> [TExpr] -> [TExpr]
    forall a. a -> [a] -> [a]
    :[TExpr]
    es1)
    getVec TExpr
    _ = Maybe [TExpr]
    forall a. Maybe a
    Nothing

    -- | Try to get the literal nat value of an expression.
    tExprToInteger :: TExpr -> Maybe Integer
    tExprToInteger :: TExpr -> Maybe Integer
    tExprToInteger (TExpr HWType
    _ Expr
    e) = Expr -> Maybe Integer
    exprToInteger Expr
    e

    exprToInteger :: Expr -> Maybe Integer
    exprToInteger :: Expr -> Maybe Integer
    exprToInteger (DataCon HWType
    _ Modifier
    _ [Expr
    n]) = Expr -> Maybe Integer
    exprToInteger Expr
    n
    exprToInteger (Literal Maybe (HWType, Int)
    _ (NumLit Integer
    n)) = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    n
    exprToInteger Expr
    _ = Maybe Integer
    forall a. Maybe a
    Nothing

    -- | Convert an expression from one type to another. Errors if result type and
    -- given expression are sized differently.
    bitCoerce ::
      (HasCallStack, Backend backend) =>
      -- | Name hints for intermediate variables
      Text ->
      -- | Type to convert to
      HWType ->
      -- | Expression to convert
      TExpr ->
      -- | Converted expression
      State (BlockState backend) TExpr
    bitCoerce :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    bitCoerce Text
    nameHint HWType
    destType e :: TExpr
    e@(TExpr HWType
    ety Expr
    _)
      | HWType -> Int
    forall i. Num i => HWType -> i
    tySize HWType
    ety Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= forall i. Num i => HWType -> i
    tySize @Int HWType
    destType = String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error String
    "Size mismatch"
      | HWType
    ety HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HWType
    destType = TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    e
      | BitVector Int
    _ <- HWType
    ety = Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    fromBV Text
    nameHint HWType
    destType TExpr
    e
      | Bool
    otherwise = Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    bitCoerce Text
    nameHint HWType
    destType (TExpr -> State (BlockState backend) TExpr)
    -> State (BlockState backend) TExpr
    -> State (BlockState backend) TExpr
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toBV Text
    nameHint TExpr
    e

    -- | Convert an expression to a BitVector
    toBV ::
      Backend backend =>
      -- | BitVector name hint
      Text ->
      -- | Expression to convert to BitVector
      TExpr ->
      -- | BitVector expression
      State (BlockState backend) TExpr
    toBV :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toBV = [Attr Text] -> Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    [Attr Text] -> Text -> TExpr -> State (BlockState backend) TExpr
    toBvWithAttrs []

    -- | Convert an expression to a BitVector and add the given HDL attributes
    toBvWithAttrs ::
      Backend backend =>
      [Attr Text] ->
      -- | BitVector name hint
      Text ->
      -- | Expression to convert to BitVector
      TExpr ->
      -- | BitVector expression
      State (BlockState backend) TExpr
    toBvWithAttrs :: forall backend.
    Backend backend =>
    [Attr Text] -> Text -> TExpr -> State (BlockState backend) TExpr
    toBvWithAttrs [Attr Text]
    attrs Text
    bvName (TExpr HWType
    aTy Expr
    aExpr) =
      Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    bvName (TExpr -> State (BlockState backend) TExpr)
    -> TExpr -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $
        HWType -> Expr -> TExpr
    TExpr
          ([Attr Text] -> HWType -> HWType
    annotated [Attr Text]
    attrs (Int -> HWType
    BitVector (HWType -> Int
    forall i. Num i => HWType -> i
    tySize HWType
    aTy)))
          (Maybe Identifier -> HWType -> Expr -> Expr
    ToBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    aTy Expr
    aExpr)

    -- | Convert an expression from a 'BitVector' into some type. If the expression
    -- is 'Annotated', only convert the expression within.
    fromBV
      :: (HasCallStack, Backend backend) =>
      -- | Result name hint
      Text ->
      -- | Type to convert to
      HWType ->
      -- | 'BitVector' expression
      TExpr ->
      -- | Converted 'BitVector' expression
      State (BlockState backend) TExpr
    fromBV :: forall backend.
    (HasCallStack, Backend backend) =>
    Text -> HWType -> TExpr -> State (BlockState backend) TExpr
    fromBV Text
    resultName HWType
    resultType e :: TExpr
    e@TExpr{Expr
    eex :: TExpr -> Expr
    eex :: Expr
    eex, ety :: TExpr -> HWType
    ety = BitVector Int
    _} =
      case HWType
    resultType of
        BitVector{} -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    e
        HWType
    _ -> Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    resultName (HWType -> Expr -> TExpr
    TExpr HWType
    resultType (Maybe Identifier -> HWType -> Expr -> Expr
    FromBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    resultType Expr
    eex))
    fromBV Text
    resultName HWType
    resultType e :: TExpr
    e@TExpr{ety :: TExpr -> HWType
    ety = Annotated [Attr Text]
    _ bv :: HWType
    bv@(BitVector Int
    _)} =
      case HWType
    resultType of
        BitVector{} -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr HWType
    bv (TExpr -> Expr
    eex TExpr
    e))
        HWType
    _ -> Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    resultName (HWType -> Expr -> TExpr
    TExpr HWType
    resultType (Maybe Identifier -> HWType -> Expr -> Expr
    FromBv Maybe Identifier
    forall a. Maybe a
    Nothing HWType
    resultType (TExpr -> Expr
    eex TExpr
    e)))
    fromBV Text
    _ HWType
    _ TExpr{HWType
    ety :: TExpr -> HWType
    ety :: HWType
    ety} = String -> State (BlockState backend) TExpr
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) TExpr)
    -> String -> State (BlockState backend) TExpr
    forall a b. (a -> b) -> a -> b
    $ String
    "fromBV: expected BitVector, got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> HWType -> String
    forall a. Show a => a -> String
    show HWType
    ety

    clog2 :: Num i => Integer -> i
    clog2 :: forall i. Num i => Integer -> i
    clog2 = Int -> i
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> i) -> (Integer -> Int) -> Integer -> i
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> (Integer -> Maybe Int) -> Integer -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Integer -> Maybe Int
    clogBase Integer
    2

    tySize :: Num i => HWType -> i
    tySize :: forall i. Num i => HWType -> i
    tySize = Int -> i
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> i) -> (HWType -> Int) -> HWType -> i
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HWType -> Int
    typeSize

    -- | A literal that can be used for hdl attributes. It has a `Num` and
    --   `IsString` instances for convenience.
    data LitHDL
      = B Bool
      | S String
      | I Integer
      deriving Int -> LitHDL -> ShowS
    [LitHDL] -> ShowS
    LitHDL -> String
    (Int -> LitHDL -> ShowS)
    -> (LitHDL -> String) -> ([LitHDL] -> ShowS) -> Show LitHDL
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LitHDL -> ShowS
    showsPrec :: Int -> LitHDL -> ShowS
    $cshow :: LitHDL -> String
    show :: LitHDL -> String
    $cshowList :: [LitHDL] -> ShowS
    showList :: [LitHDL] -> ShowS
    Show

    instance Num LitHDL where
      + :: LitHDL -> LitHDL -> LitHDL
    (+) = LitHDL -> LitHDL -> LitHDL
    forall a. HasCallStack => a
    undefined
      * :: LitHDL -> LitHDL -> LitHDL
    (*) = LitHDL -> LitHDL -> LitHDL
    forall a. HasCallStack => a
    undefined
      abs :: LitHDL -> LitHDL
    abs = LitHDL -> LitHDL
    forall a. HasCallStack => a
    undefined
      signum :: LitHDL -> LitHDL
    signum = LitHDL -> LitHDL
    forall a. HasCallStack => a
    undefined
      negate :: LitHDL -> LitHDL
    negate = LitHDL -> LitHDL
    forall a. HasCallStack => a
    undefined
      fromInteger :: Integer -> LitHDL
    fromInteger = Integer -> LitHDL
    I

    instance IsString LitHDL where
      fromString :: String -> LitHDL
    fromString = String -> LitHDL
    S

    -- | Instantiate/call a higher-order function.
    instHO
      :: Backend backend
      => BlackBoxContext
      -- ^ BlackBoxContext, used for rendering higher-order function and error
      -- reporting
      -> Int
      -- ^ Position of HO-argument. For example:
      --
      -- > fold :: forall n a . (a -> a -> a) -> Vec (n + 1) a -> a
      --
      -- would have its HO-argument at position 0, while
      --
      -- > iterateI :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a
      --
      -- would have it at position 1.
      -> (HWType, BlackBoxTemplate)
      -- ^ Result type of HO function
      -> [(TExpr, BlackBoxTemplate)]
      -- ^ Arguments and their types
      -> State (BlockState backend) TExpr
      -- ^ Result of the function
    instHO :: forall backend.
    Backend backend =>
    BlackBoxContext
    -> Int
    -> (HWType, BlackBoxTemplate)
    -> [(TExpr, BlackBoxTemplate)]
    -> State (BlockState backend) TExpr
    instHO BlackBoxContext
    bbCtx Int
    fPos (HWType
    resTy, BlackBoxTemplate
    bbResTy) [(TExpr, BlackBoxTemplate)]
    argsWithTypes = do
      let ([TExpr]
    args0, [BlackBoxTemplate]
    argTypes) = [(TExpr, BlackBoxTemplate)] -> ([TExpr], [BlackBoxTemplate])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(TExpr, BlackBoxTemplate)]
    argsWithTypes
      Int
    fSubPos <- Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int)
    -> (IntMap Int -> Maybe Int) -> IntMap Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> IntMap Int -> Maybe Int
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    fPos (IntMap Int -> Int)
    -> StateT (BlockState backend) Identity (IntMap Int)
    -> StateT (BlockState backend) Identity Int
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Getting (IntMap Int) (BlockState backend) (IntMap Int)
    -> StateT (BlockState backend) Identity (IntMap Int)
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    use Getting (IntMap Int) (BlockState backend) (IntMap Int)
    forall backend (f :: Type -> Type).
    Functor f =>
    (IntMap Int -> f (IntMap Int))
    -> BlockState backend -> f (BlockState backend)
    bsHigherOrderCalls
      (IntMap Int -> Identity (IntMap Int))
    -> BlockState backend -> Identity (BlockState backend)
    forall backend (f :: Type -> Type).
    Functor f =>
    (IntMap Int -> f (IntMap Int))
    -> BlockState backend -> f (BlockState backend)
    bsHigherOrderCalls ((IntMap Int -> Identity (IntMap Int))
     -> BlockState backend -> Identity (BlockState backend))
    -> (IntMap Int -> IntMap Int)
    -> StateT (BlockState backend) Identity ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= Int -> Int -> IntMap Int -> IntMap Int
    forall a. Int -> a -> IntMap a -> IntMap a
    IntMap.insert Int
    fPos (Int -> Int
    forall a. Enum a => a -> a
    succ Int
    fSubPos)

      -- Create argument identifiers, example: fold_ho3_0_arg0
      let
        ctxName :: Text
    ctxName = [Text] -> Text
    forall a. HasCallStack => [a] -> a
    last ((Char -> Bool) -> Text -> [Text]
    Text.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '.') (BlackBoxContext -> Text
    bbName BlackBoxContext
    bbCtx))
        baseArgName :: Text
    baseArgName = Text
    ctxName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "ho" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showt Int
    fPos 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
    fSubPos
        argName :: a -> Text
    argName a
    n = Text
    baseArgName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_arg" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Show a => a -> Text
    showt a
    n
      [Identifier]
    args1 <- (Int -> TExpr -> StateT (BlockState backend) Identity Identifier)
    -> [Int]
    -> [TExpr]
    -> StateT (BlockState backend) Identity [Identifier]
    forall (m :: Type -> Type) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (\Int
    argN -> Text -> TExpr -> StateT (BlockState backend) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' (Int -> Text
    forall a. Show a => a -> Text
    argName Int
    argN)) [(Int
    0::Int)..] [TExpr]
    args0

      let
        args2 :: [BlackBoxTemplate]
    args2 = (Identifier -> BlackBoxTemplate)
    -> [Identifier] -> [BlackBoxTemplate]
    forall a b. (a -> b) -> [a] -> [b]
    map (Element -> BlackBoxTemplate
    forall a. a -> [a]
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Element -> BlackBoxTemplate)
    -> (Identifier -> Element) -> Identifier -> BlackBoxTemplate
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Element
    Text (Text -> Element) -> (Identifier -> Text) -> Identifier -> Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identifier -> Text
    Id.toLazyText) [Identifier]
    args1

      Identifier
    resName <- Text -> HWType -> StateT (BlockState backend) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> HWType -> State (BlockState backend) Identifier
    declare' (Text
    ctxName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "ho" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showt Int
    fPos 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
    fSubPos Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_res") HWType
    resTy
      let res :: (BlackBoxTemplate, BlackBoxTemplate)
    res = ([Text -> Element
    Text (Identifier -> Text
    Id.toLazyText Identifier
    resName)], BlackBoxTemplate
    bbResTy)

      -- Render HO argument to plain text
      let component :: Element
    component = Decl -> Element
    Component (Int -> Int -> [(BlackBoxTemplate, BlackBoxTemplate)] -> Decl
    Decl Int
    fPos Int
    fSubPos ((BlackBoxTemplate, BlackBoxTemplate)
    res(BlackBoxTemplate, BlackBoxTemplate)
    -> [(BlackBoxTemplate, BlackBoxTemplate)]
    -> [(BlackBoxTemplate, BlackBoxTemplate)]
    forall a. a -> [a] -> [a]
    :[BlackBoxTemplate]
    -> [BlackBoxTemplate] -> [(BlackBoxTemplate, BlackBoxTemplate)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [BlackBoxTemplate]
    args2 [BlackBoxTemplate]
    argTypes))
      Doc
    rendered0 <-
        LensLike'
      (Zoomed (StateT backend Identity) Doc) (BlockState backend) backend
    -> StateT backend Identity Doc
    -> StateT (BlockState backend) Identity Doc
    forall c.
    LensLike'
      (Zoomed (StateT backend Identity) c) (BlockState backend) backend
    -> StateT backend Identity c
    -> StateT (BlockState backend) Identity c
    forall (m :: Type -> Type) (n :: Type -> Type) s t c.
    Zoom m n s t =>
    LensLike' (Zoomed m c) t s -> m c -> n c
    zoom (backend -> Focusing Identity Doc backend)
    -> BlockState backend -> Focusing Identity Doc (BlockState backend)
    LensLike'
      (Zoomed (StateT backend Identity) Doc) (BlockState backend) backend
    forall backend backend (f :: Type -> Type).
    Functor f =>
    (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    bsBackend (Text -> StateT backend Identity Doc
    forall (f :: Type -> Type). Applicative f => Text -> f Doc
    string (Text -> StateT backend Identity Doc)
    -> StateT backend Identity Text -> StateT backend Identity Doc
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (BlackBoxContext -> Element -> State backend (Int -> Text)
    forall backend.
    (HasCallStack, Backend backend) =>
    BlackBoxContext -> Element -> State backend (Int -> Text)
    renderElem BlackBoxContext
    bbCtx Element
    component State backend (Int -> Text)
    -> StateT backend Identity Int -> StateT backend Identity Text
    forall a b.
    StateT backend Identity (a -> b)
    -> StateT backend Identity a -> StateT backend Identity b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> Int -> StateT backend Identity Int
    forall a. a -> StateT backend Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Int
    0))

      let
        layout :: LayoutOptions
    layout = PageWidth -> LayoutOptions
    LayoutOptions (Int -> Double -> PageWidth
    AvailablePerLine Int
    120 Double
    0.4)
        rendered1 :: Text
    rendered1 = SimpleDocStream () -> Text
    forall ann. SimpleDocStream ann -> Text
    renderLazy (LayoutOptions -> Doc -> SimpleDocStream ()
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
    layoutPretty LayoutOptions
    layout Doc
    rendered0)

      Declaration -> StateT (BlockState backend) Identity ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Declaration -> StateT (BlockState backend) Identity ())
    -> Declaration -> StateT (BlockState backend) Identity ()
    forall a b. (a -> b) -> a -> b
    $
        Text
    -> [BlackBoxTemplate]
    -> [BlackBoxTemplate]
    -> [((Text, Text), BlackBox)]
    -> BlackBox
    -> BlackBoxContext
    -> Declaration
    BlackBoxD
          (Text
    "__INST_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> BlackBoxContext -> Text
    bbName BlackBoxContext
    bbCtx Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_BB_INTERNAL__") [] [] []
          (BlackBoxTemplate -> BlackBox
    BBTemplate [Text -> Element
    Text Text
    rendered1])
          (Text -> BlackBoxContext
    emptyBBContext (Text
    "__INST_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> BlackBoxContext -> Text
    bbName BlackBoxContext
    bbCtx Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_BB_INTERNAL__"))

      TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr HWType
    resTy (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    resName Maybe Modifier
    forall a. Maybe a
    Nothing))

    -- | This creates a component declaration (for VHDL) given in and out port
    -- names, updating the 'BlockState backend' stored in the 'State' monad.
    --
    -- A typical result is that a
    --
    -- @
    -- component fifo port
    --    ( rst : in std_logic
    --    ...
    --    ; full : out std_logic
    --    ; empty : out std_logic );
    --  end component;
    -- @
    --
    -- declaration would be added in the appropriate place.
    compInBlock
      :: forall backend
       . Backend backend
      => Text
      -- ^ Component name
      -> [(Text, HWType)]
      -- ^ in ports
      -> [(Text, HWType)]
      -- ^ out ports
      -> State (BlockState backend) ()
    compInBlock :: forall backend.
    Backend backend =>
    Text
    -> [(Text, HWType)]
    -> [(Text, HWType)]
    -> State (BlockState backend) ()
    compInBlock Text
    compName [(Text, HWType)]
    inPorts0 [(Text, HWType)]
    outPorts0 =
      Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Text -> [(Text, PortDirection, HWType)] -> Declaration
    CompDecl Text
    compName ([(Text, PortDirection, HWType)]
    inPorts1 [(Text, PortDirection, HWType)]
    -> [(Text, PortDirection, HWType)]
    -> [(Text, PortDirection, HWType)]
    forall a. [a] -> [a] -> [a]
    ++ [(Text, PortDirection, HWType)]
    outPorts1))
     where
      mkPort :: b -> (a, c) -> (a, b, c)
    mkPort b
    inOut (a
    nm, c
    ty) = (a
    nm, b
    inOut, c
    ty)
      inPorts1 :: [(Text, PortDirection, HWType)]
    inPorts1 = PortDirection -> (Text, HWType) -> (Text, PortDirection, HWType)
    forall {b} {a} {c}. b -> (a, c) -> (a, b, c)
    mkPort PortDirection
    In ((Text, HWType) -> (Text, PortDirection, HWType))
    -> [(Text, HWType)] -> [(Text, PortDirection, HWType)]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, HWType)]
    inPorts0
      outPorts1 :: [(Text, PortDirection, HWType)]
    outPorts1 = PortDirection -> (Text, HWType) -> (Text, PortDirection, HWType)
    forall {b} {a} {c}. b -> (a, c) -> (a, b, c)
    mkPort PortDirection
    Out ((Text, HWType) -> (Text, PortDirection, HWType))
    -> [(Text, HWType)] -> [(Text, PortDirection, HWType)]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Text, HWType)]
    outPorts0

    -- | Convert a 'LitHDL' to a 'TExpr'
    --
    -- __N.B.__: Clash 1.8 changed 'instDecl'\'s type signature. Where it would
    --           previously accept 'LitHDL' in its generics/parameters argument, it
    --           now accepts a 'TExpr'. This function is mostly there to ease this
    --           transition.
    litTExpr :: LitHDL -> TExpr
    litTExpr :: LitHDL -> TExpr
    litTExpr (B Bool
    b) = HWType -> Expr -> TExpr
    TExpr HWType
    Bool    (Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Bool -> Literal
    BoolLit Bool
    b))
    litTExpr (S String
    s) = HWType -> Expr -> TExpr
    TExpr HWType
    String  (Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (String -> Literal
    StringLit String
    s))
    litTExpr (I Integer
    i) = HWType -> Expr -> TExpr
    TExpr HWType
    Integer (Maybe (HWType, Int) -> Literal -> Expr
    Literal Maybe (HWType, Int)
    forall a. Maybe a
    Nothing (Integer -> Literal
    NumLit Integer
    i))

    -- | Instantiate a component/entity in a block state
    instDecl
      :: forall backend
       . Backend backend
      => EntityOrComponent
      -- ^ Type of instantiation
      -> Identifier
      -- ^ Component/entity name
      -> Identifier
      -- ^ Instantiation label
      -> [(Text, TExpr)]
      -- ^ Generics / parameters
      -> [(Text, TExpr)]
      -- ^ In ports
      -> [(Text, TExpr)]
      -- ^ Out ports
      -> State (BlockState backend) ()
    instDecl :: forall backend.
    Backend backend =>
    EntityOrComponent
    -> Identifier
    -> Identifier
    -> [(Text, TExpr)]
    -> [(Text, TExpr)]
    -> [(Text, TExpr)]
    -> State (BlockState backend) ()
    instDecl EntityOrComponent
    entOrComp Identifier
    compName Identifier
    instLbl [(Text, TExpr)]
    params [(Text, TExpr)]
    inPorts [(Text, TExpr)]
    outPorts = do

      [(Expr, PortDirection, HWType, Expr)]
    inPorts' <- ((Text, TExpr)
     -> StateT
          (BlockState backend) Identity (Expr, PortDirection, HWType, Expr))
    -> [(Text, TExpr)]
    -> StateT
         (BlockState backend) Identity [(Expr, PortDirection, HWType, Expr)]
    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 (PortDirection
    -> (Text, TExpr)
    -> StateT
         (BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
    mkPort PortDirection
    In) [(Text, TExpr)]
    inPorts
      [(Expr, PortDirection, HWType, Expr)]
    outPorts' <- ((Text, TExpr)
     -> StateT
          (BlockState backend) Identity (Expr, PortDirection, HWType, Expr))
    -> [(Text, TExpr)]
    -> StateT
         (BlockState backend) Identity [(Expr, PortDirection, HWType, Expr)]
    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 (PortDirection
    -> (Text, TExpr)
    -> StateT
         (BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
    mkPort PortDirection
    Out) [(Text, TExpr)]
    outPorts

      Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Declaration -> State (BlockState backend) ())
    -> Declaration -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $
        EntityOrComponent
    -> Maybe Text
    -> [Attr Text]
    -> Identifier
    -> Identifier
    -> [(Expr, HWType, Expr)]
    -> PortMap
    -> Declaration
    InstDecl
          EntityOrComponent
    entOrComp Maybe Text
    forall a. Maybe a
    Nothing [] Identifier
    compName Identifier
    instLbl ([(Text, TExpr)] -> [(Expr, HWType, Expr)]
    mkParams [(Text, TExpr)]
    params)
          ([(Expr, PortDirection, HWType, Expr)] -> PortMap
    NamedPortMap ([(Expr, PortDirection, HWType, Expr)]
    inPorts' [(Expr, PortDirection, HWType, Expr)]
    -> [(Expr, PortDirection, HWType, Expr)]
    -> [(Expr, PortDirection, HWType, Expr)]
    forall a. [a] -> [a] -> [a]
    ++ [(Expr, PortDirection, HWType, Expr)]
    outPorts'))
       where
        mkPort
          :: PortDirection
          -> (Text, TExpr)
          -> StateT (BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
        mkPort :: PortDirection
    -> (Text, TExpr)
    -> StateT
         (BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
    mkPort PortDirection
    inOrOut (Text
    nmText, TExpr
    pExpr) = do
          TExpr HWType
    ty Expr
    pExpr' <- Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toIdentifier (Text
    nmText Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_port")  TExpr
    pExpr
          (Expr, PortDirection, HWType, Expr)
    -> StateT
         (BlockState backend) Identity (Expr, PortDirection, HWType, Expr)
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    nmText) Maybe Modifier
    forall a. Maybe a
    Nothing, PortDirection
    inOrOut, HWType
    ty, Expr
    pExpr')

        -- Convert a list of name generics / parameters to the form clash wants
        mkParams :: [(Text.Text, TExpr)] -> [(Expr, HWType, Expr)]
        mkParams :: [(Text, TExpr)] -> [(Expr, HWType, Expr)]
    mkParams = ((Text, TExpr) -> (Expr, HWType, Expr))
    -> [(Text, TExpr)] -> [(Expr, HWType, Expr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Text, TExpr) -> (Expr, HWType, Expr))
     -> [(Text, TExpr)] -> [(Expr, HWType, Expr)])
    -> ((Text, TExpr) -> (Expr, HWType, Expr))
    -> [(Text, TExpr)]
    -> [(Expr, HWType, Expr)]
    forall a b. (a -> b) -> a -> b
    $ \(Text
    paramName, TExpr
    texpr) ->
          ( Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    paramName) Maybe Modifier
    forall a. Maybe a
    Nothing
          , TExpr -> HWType
    ety TExpr
    texpr
          , TExpr -> Expr
    eex TExpr
    texpr )

    -- | Wires the two given `TExpr`s together using a newly declared
    -- signal with (exactly) the given name `sigNm`. The new signal has an
    -- annotated type, using the given attributes.
    viaAnnotatedSignal
      :: (HasCallStack, Backend backend)
      => Identifier
      -- ^ Name given to signal
      -> TExpr
      -- ^ expression the signal is assigned to
      -> TExpr
      -- ^ expression (must be identifier) to which the signal is assigned
      -> [Attr Text]
      -- ^ the attributes to annotate the signal with
      -> State (BlockState backend) ()
    viaAnnotatedSignal :: forall backend.
    (HasCallStack, Backend backend) =>
    Identifier
    -> TExpr -> TExpr -> [Attr Text] -> State (BlockState backend) ()
    viaAnnotatedSignal Identifier
    sigNm (TExpr HWType
    fromTy Expr
    fromExpr) (TExpr HWType
    toTy (Identifier Identifier
    outNm Maybe Modifier
    Nothing)) [Attr Text]
    attrs
      | HWType
    fromTy HWType -> HWType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HWType
    toTy = do
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Maybe Text -> Identifier -> HWType -> Declaration
    NetDecl Maybe Text
    forall a. Maybe a
    Nothing Identifier
    sigNm ([Attr Text] -> HWType -> HWType
    Annotated [Attr Text]
    attrs HWType
    fromTy))
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    sigNm Usage
    Cont Expr
    fromExpr)
          Declaration -> State (BlockState backend) ()
    forall backend. Declaration -> State (BlockState backend) ()
    addDeclaration (Identifier -> Usage -> Expr -> Declaration
    Assignment Identifier
    outNm Usage
    Cont (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    sigNm Maybe Modifier
    forall a. Maybe a
    Nothing))
    viaAnnotatedSignal Identifier
    _ TExpr
    inTExpr outTExpr :: TExpr
    outTExpr@(TExpr HWType
    _ (Identifier Identifier
    _ Maybe Modifier
    _)) [Attr Text]
    _ =
      String -> State (BlockState backend) ()
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) ())
    -> String -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $ String
    "viaAnnotatedSignal: The in and out expressions \"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    inTExpr String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
      String
    "\" and \"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    outTExpr String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "\" have non-matching types."
    viaAnnotatedSignal Identifier
    _ TExpr
    _ TExpr
    outTExpr [Attr Text]
    _ =
      String -> State (BlockState backend) ()
    forall a. HasCallStack => String -> a
    error (String -> State (BlockState backend) ())
    -> String -> State (BlockState backend) ()
    forall a b. (a -> b) -> a -> b
    $ String
    "viaAnnotatedSignal: The out expression \"" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    outTExpr String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
      String
    "\" must be an Identifier."

    -- | The TExp inputs from a blackbox context.
    tInputs :: BlackBoxContext -> [(TExpr, HWType)]
    tInputs :: BlackBoxContext -> [(TExpr, HWType)]
    tInputs = ((Expr, HWType, Bool) -> (TExpr, HWType))
    -> [(Expr, HWType, Bool)] -> [(TExpr, HWType)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Expr
    x, HWType
    t, Bool
    _) -> (HWType -> Expr -> TExpr
    TExpr HWType
    t Expr
    x, HWType
    t)) ([(Expr, HWType, Bool)] -> [(TExpr, HWType)])
    -> (BlackBoxContext -> [(Expr, HWType, Bool)])
    -> BlackBoxContext
    -> [(TExpr, HWType)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlackBoxContext -> [(Expr, HWType, Bool)]
    bbInputs

    -- | The TExp result of a blackbox context.
    tResults :: BlackBoxContext -> [TExpr]
    tResults :: BlackBoxContext -> [TExpr]
    tResults = ((Expr, HWType) -> TExpr) -> [(Expr, HWType)] -> [TExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Expr
    x,HWType
    t) -> HWType -> Expr -> TExpr
    TExpr HWType
    t Expr
    x) ([(Expr, HWType)] -> [TExpr])
    -> (BlackBoxContext -> [(Expr, HWType)])
    -> BlackBoxContext
    -> [TExpr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlackBoxContext -> [(Expr, HWType)]
    bbResults

    -- | Get an identifier to an expression, creating a new assignment if
    --   necessary.
    toIdentifier'
      :: Backend backend
      => Text
      -- ^ desired new identifier name, will be made unique
      -> TExpr
      -- ^ expression to get identifier of
      -> State (BlockState backend) Identifier
      -- ^ identifier to expression
    toIdentifier' :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' Text
    _ (TExpr HWType
    _ (Identifier Identifier
    aExpr Maybe Modifier
    Nothing)) = Identifier -> StateT (BlockState backend) Identity Identifier
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Identifier
    aExpr
    toIdentifier' Text
    nm TExpr
    texp = do
      TExpr
    t <- Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    nm TExpr
    texp
      let nm' :: Identifier
    nm' = case TExpr
    t of
                  TExpr HWType
    _ (Identifier Identifier
    x Maybe Modifier
    Nothing) -> Identifier
    x
                  TExpr
    t' -> String -> Identifier
    forall a. HasCallStack => String -> a
    error (String
    "toIdentifier' expected an Identifier, but got: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TExpr -> String
    forall a. Show a => a -> String
    show TExpr
    t')
      Identifier -> StateT (BlockState backend) Identity Identifier
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Identifier
    nm'

    -- | Get an identifier to an expression, creating a new assignment if
    --   necessary.
    toIdentifier
      :: Backend backend
      => Text
      -- ^ desired new identifier name, will be made unique
      -> TExpr
      -- ^ expression to get identifier of
      -> State (BlockState backend) TExpr
      -- ^ identifier to expression
    toIdentifier :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    toIdentifier Text
    nm TExpr
    texp = do
      Identifier
    id' <- Text -> TExpr -> State (BlockState backend) Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' Text
    nm TExpr
    texp
      TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HWType -> Expr -> TExpr
    TExpr (TExpr -> HWType
    ety TExpr
    texp) (Identifier -> Maybe Modifier -> Expr
    Identifier Identifier
    id' Maybe Modifier
    forall a. Maybe a
    Nothing))

    -- | And together @(&&)@ two expressions, assigning it to a new identifier.
    andExpr
      :: Backend backend
      => Text
      -- ^ name hint
      -> TExpr
      -- ^ a
      -> TExpr
      -- ^ a
      -> State (BlockState backend) TExpr
      -- ^ a && b
    andExpr :: forall backend.
    Backend backend =>
    Text -> TExpr -> TExpr -> State (BlockState backend) TExpr
    andExpr Text
    _ TExpr
    T TExpr
    bExpr = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    bExpr
    andExpr Text
    _ TExpr
    F TExpr
    _     = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    F
    andExpr Text
    _ TExpr
    aExpr TExpr
    T = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    aExpr
    andExpr Text
    _ TExpr
    _ TExpr
    F     = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    F
    andExpr Text
    nm TExpr
    a TExpr
    b = do
      Text
    aIdent <- Identifier -> Text
    Id.toText (Identifier -> Text)
    -> StateT (BlockState backend) Identity Identifier
    -> StateT (BlockState backend) Identity Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> TExpr -> StateT (BlockState backend) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' (Text
    nm Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_a") TExpr
    a
      Text
    bIdent <- Identifier -> Text
    Id.toText (Identifier -> Text)
    -> StateT (BlockState backend) Identity Identifier
    -> StateT (BlockState backend) Identity Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> TExpr -> StateT (BlockState backend) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' (Text
    nm Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_b") TExpr
    b
      -- This is somewhat hacky and relies on the fact that clash doesn't
      -- postprocess the text in Identifier. The alternative is to run
      -- this as a fully fledged @BlackBoxE@ but that involves a lot of
      -- faffing. It should be reasonably safe because we assign each side
      -- to an identifier if it isn't already.
      Text
    andTxt <-
        LensLike' (Const HDL) (BlockState backend) backend
    -> (backend -> HDL) -> StateT (BlockState backend) Identity HDL
    forall s (m :: Type -> Type) r a.
    MonadState s m =>
    LensLike' (Const r) s a -> (a -> r) -> m r
    uses LensLike' (Const HDL) (BlockState backend) backend
    forall backend backend (f :: Type -> Type).
    Functor f =>
    (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    bsBackend backend -> HDL
    forall state. Backend state => state -> HDL
    hdlKind StateT (BlockState backend) Identity HDL
    -> (HDL -> Text) -> StateT (BlockState backend) Identity Text
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
    <&> \case
          HDL
    VHDL          -> Text
    aIdent Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " and " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    bIdent
          HDL
    Verilog       -> Text
    aIdent Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " && " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    bIdent
          HDL
    SystemVerilog -> Text
    aIdent Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " && " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    bIdent
      Text -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    nm (TExpr -> StateT (BlockState backend) Identity TExpr)
    -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall a b. (a -> b) -> a -> b
    $ HWType -> Expr -> TExpr
    TExpr HWType
    Bool (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    andTxt) Maybe Modifier
    forall a. Maybe a
    Nothing)

    -- | Massage a reset to work as active-high reset.
    unsafeToActiveHigh
      :: Backend backend
      => Text
      -- ^ Name hint
      -> TExpr
      -- ^ Reset signal
      -> State (BlockState backend) TExpr
    unsafeToActiveHigh :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    unsafeToActiveHigh Text
    nm TExpr
    rExpr = do
      ResetPolarity
    resetLevel <- VDomainConfiguration -> ResetPolarity
    vResetPolarity (VDomainConfiguration -> ResetPolarity)
    -> StateT (BlockState backend) Identity VDomainConfiguration
    -> StateT (BlockState backend) Identity ResetPolarity
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> State backend VDomainConfiguration
    -> StateT (BlockState backend) Identity VDomainConfiguration
    forall backend a.
    Backend backend =>
    State backend a -> State (BlockState backend) a
    liftToBlockState (HWType -> State backend VDomainConfiguration
    forall backend.
    (Backend backend, HasCallStack) =>
    HWType -> State backend VDomainConfiguration
    getDomainConf (TExpr -> HWType
    ety TExpr
    rExpr))
      case ResetPolarity
    resetLevel of
        ResetPolarity
    ActiveHigh -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    rExpr
        ResetPolarity
    ActiveLow -> Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    notExpr Text
    nm TExpr
    rExpr

    -- | Massage a reset to work as active-low reset.
    unsafeToActiveLow
      :: Backend backend
      => Text
      -- ^ Name hint
      -> TExpr
      -- ^ Reset signal
      -> State (BlockState backend) TExpr
    unsafeToActiveLow :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    unsafeToActiveLow Text
    nm TExpr
    rExpr = do
      ResetPolarity
    resetLevel <- VDomainConfiguration -> ResetPolarity
    vResetPolarity (VDomainConfiguration -> ResetPolarity)
    -> StateT (BlockState backend) Identity VDomainConfiguration
    -> StateT (BlockState backend) Identity ResetPolarity
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> State backend VDomainConfiguration
    -> StateT (BlockState backend) Identity VDomainConfiguration
    forall backend a.
    Backend backend =>
    State backend a -> State (BlockState backend) a
    liftToBlockState (HWType -> State backend VDomainConfiguration
    forall backend.
    (Backend backend, HasCallStack) =>
    HWType -> State backend VDomainConfiguration
    getDomainConf (TExpr -> HWType
    ety TExpr
    rExpr))
      case ResetPolarity
    resetLevel of
        ResetPolarity
    ActiveLow -> TExpr -> State (BlockState backend) TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    rExpr
        ResetPolarity
    ActiveHigh -> Text -> TExpr -> State (BlockState backend) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    notExpr Text
    nm TExpr
    rExpr

    -- | Negate @(not)@ an expression, assigning it to a new identifier.
    notExpr
      :: Backend backend
      => Text
      -- ^ name hint
      -> TExpr
      -- ^ @a@
      -> State (BlockState backend) TExpr
      -- ^ @not a@
    notExpr :: forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    notExpr Text
    _ TExpr
    T = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    F
    notExpr Text
    _ TExpr
    F = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TExpr
    T
    notExpr Text
    nm TExpr
    aExpr = do
      Text
    aIdent <- Identifier -> Text
    Id.toText (Identifier -> Text)
    -> StateT (BlockState backend) Identity Identifier
    -> StateT (BlockState backend) Identity Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> TExpr -> StateT (BlockState backend) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' (Text
    nm Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_a") TExpr
    aExpr
      -- See disclaimer in `andExpr` above.
      Text
    notTxt <- LensLike' (Const HDL) (BlockState backend) backend
    -> (backend -> HDL) -> StateT (BlockState backend) Identity HDL
    forall s (m :: Type -> Type) r a.
    MonadState s m =>
    LensLike' (Const r) s a -> (a -> r) -> m r
    uses LensLike' (Const HDL) (BlockState backend) backend
    forall backend backend (f :: Type -> Type).
    Functor f =>
    (backend -> f backend)
    -> BlockState backend -> f (BlockState backend)
    bsBackend backend -> HDL
    forall state. Backend state => state -> HDL
    hdlKind StateT (BlockState backend) Identity HDL
    -> (HDL -> Text) -> StateT (BlockState backend) Identity Text
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
    <&> \case
        HDL
    VHDL          -> Text
    "not " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    aIdent
        HDL
    Verilog       -> Text
    "! " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    aIdent
        HDL
    SystemVerilog -> Text
    "! " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    aIdent
      Text -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    nm (TExpr -> StateT (BlockState backend) Identity TExpr)
    -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall a b. (a -> b) -> a -> b
    $ HWType -> Expr -> TExpr
    TExpr HWType
    Bit (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    notTxt) Maybe Modifier
    forall a. Maybe a
    Nothing)

    -- | Creates a BV that produces the following vhdl:
    --
    -- @
    --    (0 to n => ARG)
    -- @
    --
    -- TODO: Implement for (System)Verilog
    pureToBV
      :: Text
      -- ^ name hint
      -> Int
      -- ^ Size (n)
      -> TExpr
      -- ^ @ARG@
      -> State (BlockState VHDLState) TExpr
      -- ^ @(0 to n => ARG)@
    pureToBV :: Text -> Int -> TExpr -> State (BlockState VHDLState) TExpr
    pureToBV Text
    nm Int
    n TExpr
    arg = do
      Text
    arg' <- Identifier -> Text
    Id.toText (Identifier -> Text)
    -> StateT (BlockState VHDLState) Identity Identifier
    -> StateT (BlockState VHDLState) Identity Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> TExpr -> StateT (BlockState VHDLState) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' Text
    nm TExpr
    arg
      -- This is very hard coded and hacky
      let text :: Text
    text = Text
    "(0 to " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showt Int
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " => " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    arg' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
      Text -> TExpr -> State (BlockState VHDLState) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    nm (TExpr -> State (BlockState VHDLState) TExpr)
    -> TExpr -> State (BlockState VHDLState) TExpr
    forall a b. (a -> b) -> a -> b
    $ HWType -> Expr -> TExpr
    TExpr (Int -> HWType
    BitVector (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)) (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    text) Maybe Modifier
    forall a. Maybe a
    Nothing)

    -- | Creates a BV that produces the following vhdl:
    --
    -- @
    --    std_logic_vector(resize(ARG, n))
    -- @
    --
    -- TODO: Implement for (System)Verilog
    pureToBVResized
      :: Text
      -- ^ name hint
      -> Int
      -- ^ Size (n)
      -> TExpr
      -- ^ ARG
      -> State (BlockState VHDLState) TExpr
      -- ^ @std_logic_vector(resize(ARG, n))@
    pureToBVResized :: Text -> Int -> TExpr -> State (BlockState VHDLState) TExpr
    pureToBVResized Text
    nm Int
    n TExpr
    arg = do
      Text
    arg' <- Identifier -> Text
    Id.toText (Identifier -> Text)
    -> StateT (BlockState VHDLState) Identity Identifier
    -> StateT (BlockState VHDLState) Identity Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> TExpr -> StateT (BlockState VHDLState) Identity Identifier
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) Identifier
    toIdentifier' Text
    nm TExpr
    arg
      -- This is very hard coded and hacky
      let text :: Text
    text = Text
    "std_logic_vector(resize(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    arg' 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
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "))"
      Text -> TExpr -> State (BlockState VHDLState) TExpr
    forall backend.
    Backend backend =>
    Text -> TExpr -> State (BlockState backend) TExpr
    assign Text
    nm (TExpr -> State (BlockState VHDLState) TExpr)
    -> TExpr -> State (BlockState VHDLState) TExpr
    forall a b. (a -> b) -> a -> b
    $ HWType -> Expr -> TExpr
    TExpr (Int -> HWType
    BitVector Int
    n) (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    text) Maybe Modifier
    forall a. Maybe a
    Nothing)

    -- | Allows assignment of a port to be "open"
    open
      :: Backend backend
      => HWType
      -> State (BlockState backend) TExpr
    open :: forall backend.
    Backend backend =>
    HWType -> State (BlockState backend) TExpr
    open HWType
    hwType = TExpr -> StateT (BlockState backend) Identity TExpr
    forall a. a -> StateT (BlockState backend) Identity a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (TExpr -> StateT (BlockState backend) Identity TExpr)
    -> TExpr -> StateT (BlockState backend) Identity TExpr
    forall a b. (a -> b) -> a -> b
    $ HWType -> Expr -> TExpr
    TExpr HWType
    hwType (Identifier -> Maybe Modifier -> Expr
    Identifier (HasCallStack => Text -> Identifier
    Text -> Identifier
    Id.unsafeMake Text
    "open") Maybe Modifier
    forall a. Maybe a
    Nothing)