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

  Generate VHDL for assorted Netlist datatypes
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}

module Clash.Backend.VHDL (VHDLState) where

import           Control.Arrow                        (second)
#if !MIN_VERSION_base(4,18,0)
import           Control.Applicative                  (liftA2)
#endif
import           Control.Lens                         hiding (Indexed, Empty)
import           Control.Monad                        (forM,join,zipWithM)
import           Control.Monad.State                  (State, StateT)
import           Data.Bifunctor                       (first)
import           Data.Bits                            (testBit, Bits)
import qualified Data.ByteString.Char8                as B8
import           Data.Coerce                          (coerce)
import           Data.Function                        (on)
import           Data.HashMap.Lazy                    (HashMap)
import qualified Data.HashMap.Lazy                    as HashMap
import qualified Data.HashMap.Strict                  as HashMapS
import           Data.HashSet                         (HashSet)
import qualified Data.HashSet                         as HashSet
import           Data.List
  (mapAccumL, nub, nubBy, intersperse, group, sort)
import           Data.List.Extra                      ((<:>), equalLength, zipEqual)
import           Data.Maybe                           (catMaybes,mapMaybe)
import           Data.Monoid                          (Ap(Ap))
import           Data.Monoid.Extra                    ()
import qualified Data.Text.Lazy                       as T
import qualified Data.Text                            as TextS
import           Data.Text.Extra

#if MIN_VERSION_prettyprinter(1,7,0)
import qualified Prettyprinter                        as PP
#else
import qualified Data.Text.Prettyprint.Doc            as PP
#endif

import           Data.Text.Prettyprint.Doc.Extra
import           GHC.Stack                            (HasCallStack)
import qualified System.FilePath
import           Text.Printf

import           Clash.Annotations.Primitive          (HDL (..))
import           Clash.Annotations.BitRepresentation.Internal
  (ConstrRepr'(..), DataRepr'(..))
import           Clash.Annotations.BitRepresentation.ClashLib
  (bitsToBits)
import           Clash.Annotations.BitRepresentation.Util
  (BitOrigin(Lit, Field), bitOrigins, bitRanges)
import           Clash.Annotations.SynthesisAttributes (Attr(..))
import           Clash.Backend
import           Clash.Debug                          (traceIf)
import           Clash.Driver.Types                   (ClashOpts(..))
import           Clash.Explicit.BlockRam.Internal     (unpackNats)
import           Clash.Netlist.BlackBox.Types         (HdlSyn (..))
import           Clash.Netlist.BlackBox.Util
  (extractLiterals, renderBlackBox, renderFilePath)
import qualified Clash.Netlist.Id                     as Id
import           Clash.Netlist.Types                  hiding (intWidth, usages, _usages)
import           Clash.Netlist.Util
import           Clash.Util
  (SrcSpan, noSrcSpan, clogBase, curLoc, makeCached, indexNote)
import qualified Clash.Util.Interpolate               as I
import           Clash.Util.Graph                     (reverseTopSort)

import           Clash.Backend.Verilog (Range (..), continueWithRange)
import           Debug.Trace (traceM)

-- | State for the 'Clash.Netlist.VHDL.VHDLM' monad:
data VHDLState =
  VHDLState
  { VHDLState -> HashSet HWType
_tyCache   :: HashSet HWType
  -- ^ Previously encountered HWTypes
  , VHDLState -> HashMap (HWType, Bool) Text
_nameCache :: (HashMap (HWType, Bool) TextS.Text)
  -- ^ Cache for type names. Bool indicates whether this name includes length
  -- information in its first "part". See `tyName'` for more information.
  , VHDLState -> Text
_modNm     :: ModName
  , VHDLState -> Identifier
_topNm     :: Identifier
  , VHDLState -> SrcSpan
_srcSpan   :: SrcSpan
  , VHDLState -> [Text]
_libraries :: [T.Text]
  , VHDLState -> [Text]
_packages  :: [T.Text]
  , VHDLState -> [(String, Doc)]
_includes  :: [(String,Doc)]
  , VHDLState -> [(String, String)]
_dataFiles      :: [(String,FilePath)]
  -- ^ Files to be copied: (filename, old path)
  , VHDLState -> [(String, String)]
_memoryDataFiles:: [(String,String)]
  -- ^ Files to be stored: (filename, contents). These files are generated
  -- during the execution of 'genNetlist'.
  , VHDLState -> IdentifierSet
_idSeen    :: IdentifierSet
  , VHDLState -> Bool
_tyPkgCtx :: Bool
  -- ^ Are we in the context of generating the @_types@ package?
  , VHDLState -> Int
_intWidth  :: Int
  -- ^ Int/Word/Integer bit-width
  , VHDLState -> HdlSyn
_hdlsyn    :: HdlSyn
  -- ^ For which HDL synthesis tool are we generating VHDL
  , VHDLState -> Maybe (Maybe Int)
_undefValue :: Maybe (Maybe Int)
  , VHDLState -> HashMap (Maybe [Text], [HWType]) [Text]
_productFieldNameCache :: HashMap (Maybe [TextS.Text], [HWType]) [TextS.Text]
  -- ^ Caches output of 'productFieldNames'.
  , VHDLState -> HashMap HWType [Text]
_enumNameCache :: HashMap HWType [TextS.Text]
  -- ^ Cache for enum variant names.
  , VHDLState -> AggressiveXOptBB
_aggressiveXOptBB_ :: AggressiveXOptBB
  , VHDLState -> RenderEnums
_renderEnums_ :: RenderEnums
  , VHDLState -> DomainMap
_domainConfigurations_ :: DomainMap
  , VHDLState -> UsageMap
_usages :: UsageMap
  }

makeLenses ''VHDLState

instance HasIdentifierSet VHDLState where
  identifierSet :: Lens' VHDLState IdentifierSet
identifierSet = (IdentifierSet -> f IdentifierSet) -> VHDLState -> f VHDLState
Lens' VHDLState IdentifierSet
idSeen

instance HasUsageMap VHDLState where
  usageMap :: Lens' VHDLState UsageMap
usageMap = (UsageMap -> f UsageMap) -> VHDLState -> f VHDLState
Lens' VHDLState UsageMap
usages

instance Backend VHDLState where
  initBackend :: ClashOpts -> VHDLState
initBackend ClashOpts
opts = VHDLState
    { _tyCache :: HashSet HWType
_tyCache=HashSet HWType
forall a. Monoid a => a
mempty
    , _nameCache :: HashMap (HWType, Bool) Text
_nameCache=HashMap (HWType, Bool) Text
forall a. Monoid a => a
mempty
    , _modNm :: Text
_modNm=Text
""
    , _topNm :: Identifier
_topNm=HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake Text
""
    , _srcSpan :: SrcSpan
_srcSpan=SrcSpan
noSrcSpan
    , _libraries :: [Text]
_libraries=[]
    , _packages :: [Text]
_packages=[]
    , _includes :: [(String, Doc)]
_includes=[]
    , _dataFiles :: [(String, String)]
_dataFiles=[]
    , _memoryDataFiles :: [(String, String)]
_memoryDataFiles=[]
    , _idSeen :: IdentifierSet
_idSeen=Bool -> PreserveCase -> HDL -> IdentifierSet
Id.emptyIdentifierSet (ClashOpts -> Bool
opt_escapedIds ClashOpts
opts) (ClashOpts -> PreserveCase
opt_lowerCaseBasicIds ClashOpts
opts) HDL
VHDL
    , _tyPkgCtx :: Bool
_tyPkgCtx=Bool
False
    , _intWidth :: Int
_intWidth=ClashOpts -> Int
opt_intWidth ClashOpts
opts
    , _hdlsyn :: HdlSyn
_hdlsyn=ClashOpts -> HdlSyn
opt_hdlSyn ClashOpts
opts
    , _undefValue :: Maybe (Maybe Int)
_undefValue=ClashOpts -> Maybe (Maybe Int)
opt_forceUndefined ClashOpts
opts
    , _productFieldNameCache :: HashMap (Maybe [Text], [HWType]) [Text]
_productFieldNameCache=HashMap (Maybe [Text], [HWType]) [Text]
forall a. Monoid a => a
mempty
    , _enumNameCache :: HashMap HWType [Text]
_enumNameCache=HashMap HWType [Text]
forall a. Monoid a => a
mempty
    , _aggressiveXOptBB_ :: AggressiveXOptBB
_aggressiveXOptBB_=Bool -> AggressiveXOptBB
forall a b. Coercible a b => a -> b
coerce (ClashOpts -> Bool
opt_aggressiveXOptBB ClashOpts
opts)
    , _renderEnums_ :: RenderEnums
_renderEnums_=Bool -> RenderEnums
forall a b. Coercible a b => a -> b
coerce (ClashOpts -> Bool
opt_renderEnums ClashOpts
opts)
    , _domainConfigurations_ :: DomainMap
_domainConfigurations_=DomainMap
emptyDomainMap
    , _usages :: UsageMap
_usages=UsageMap
forall a. Monoid a => a
mempty
    }
  hdlKind :: VHDLState -> HDL
hdlKind         = HDL -> VHDLState -> HDL
forall a b. a -> b -> a
const HDL
VHDL
  primDirs :: VHDLState -> IO [String]
primDirs        = IO [String] -> VHDLState -> IO [String]
forall a b. a -> b -> a
const (IO [String] -> VHDLState -> IO [String])
-> IO [String] -> VHDLState -> IO [String]
forall a b. (a -> b) -> a -> b
$ do String
root <- IO String
primsRoot
                               [String] -> IO [String]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ String
root String -> String -> String
System.FilePath.</> String
"common"
                                      , String
root String -> String -> String
System.FilePath.</> String
"vhdl"
                                      ]
  extractTypes :: VHDLState -> HashSet HWType
extractTypes    = VHDLState -> HashSet HWType
_tyCache
  name :: VHDLState -> String
name            = String -> VHDLState -> String
forall a b. a -> b -> a
const String
"vhdl"
  extension :: VHDLState -> String
extension       = String -> VHDLState -> String
forall a b. a -> b -> a
const String
".vhdl"

  genHDL :: ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VHDLState) ((String, Doc), [(String, Doc)])
genHDL          = ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL
  mkTyPackage :: Text -> [HWType] -> Ap (State VHDLState) [(String, Doc)]
mkTyPackage     = Text -> [HWType] -> Ap (State VHDLState) [(String, Doc)]
mkTyPackage_
  hdlHWTypeKind :: HWType -> State VHDLState HWKind
hdlHWTypeKind = \case
    Vector {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    RTree {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    Product {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    MemBlob {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType

    Sum {} -> do
      -- If an enum is rendered, it is a user type. If not, an std_logic_vector
      -- is rendered, and it is a synonym.
      RenderEnums Bool
enums <- State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
      if Bool
enums then HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType else HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType

    Clock {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    ClockN {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Reset {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Enable {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Index {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    CustomSP {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    SP {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    -- TODO This could possibly be changed to a VHDL enum as well, provided the
    -- enum_encoding attribute behaves as desired in different tools
    CustomSum {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    CustomProduct {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType

    BitVector Int
_ -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
Bool -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
Bit -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    Unsigned {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    Signed {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
String -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
Integer -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
FileType -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType

    -- Transparent types:
    BiDirectional PortDirection
_ HWType
ty -> HWType -> State VHDLState HWKind
forall state. Backend state => HWType -> State state HWKind
hdlHWTypeKind HWType
ty
    Annotated [Attr Text]
_ HWType
ty -> HWType -> State VHDLState HWKind
forall state. Backend state => HWType -> State state HWKind
hdlHWTypeKind HWType
ty

    -- Shouldn't be printed?
    Void {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    KnownDomain {} -> HWKind -> State VHDLState HWKind
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType

  hdlType :: Usage -> HWType -> VHDLM Doc
hdlType Usage
Internal      (HWType -> HWType
filterTransparent -> HWType
ty) = HWType -> VHDLM Doc
sizedQualTyName HWType
ty
  hdlType (External Text
nm) (HWType -> HWType
filterTransparent -> HWType
ty) =
    let sized :: VHDLM Doc
sized = HWType -> VHDLM Doc
sizedQualTyName HWType
ty in
    case HWType
ty of
      HWType
Bit         -> VHDLM Doc
sized
      HWType
Bool        -> VHDLM Doc
sized
      Signed Int
_    -> VHDLM Doc
sized
      Unsigned Int
_  -> VHDLM Doc
sized
      BitVector Int
_ -> VHDLM Doc
sized
      HWType
_           -> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
sized
  hdlTypeErrValue :: HWType -> VHDLM Doc
hdlTypeErrValue = HWType -> VHDLM Doc
sizedQualTyNameErrValue
  hdlTypeMark :: HWType -> VHDLM Doc
hdlTypeMark     = HWType -> VHDLM Doc
qualTyName
  hdlRecSel :: HWType -> Int -> VHDLM Doc
hdlRecSel       = HWType -> Int -> VHDLM Doc
vhdlRecSel
  hdlSig :: Text -> HWType -> VHDLM Doc
hdlSig Text
t HWType
ty     = VHDLM Doc -> HWType -> VHDLM Doc
sigDecl (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
t) HWType
ty
  genStmt :: Bool -> State VHDLState Doc
genStmt         = State VHDLState Doc -> Bool -> State VHDLState Doc
forall a b. a -> b -> a
const State VHDLState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
  inst :: Declaration -> Ap (State VHDLState) (Maybe Doc)
inst            = Declaration -> Ap (State VHDLState) (Maybe Doc)
inst_
  expr :: Bool -> Expr -> VHDLM Doc
expr            = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_
  iwWidth :: State VHDLState Int
iwWidth         = Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth

  toBV :: HWType -> Text -> VHDLM Doc
toBV HWType
t Text
id_ = do
    RenderEnums
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
    if RenderEnums -> HWType -> Bool
isBV RenderEnums
enums HWType
t then Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_ else do
      Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
      -- TODO: restore hack
--      seen <- use seenIdentifiers
      -- This is a bit hacky, as id_ is just a rendered expression.
      -- But if it's a bare identifier that we've seen before,
      -- then this identifier has a defined type and we can skip the explicit type qualification.
--      let e | T.toStrict id_ `HashMapS.member` seen = pretty id_
--            | otherwise =
      let e :: VHDLM Doc
e = HWType -> VHDLM Doc
forall state. Backend state => HWType -> Ap (State state) Doc
hdlTypeMark HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
      Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
e
  fromBV :: HWType -> Text -> VHDLM Doc
fromBV HWType
t Text
id_ = do
    RenderEnums
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
    if RenderEnums -> HWType -> Bool
isBV RenderEnums
enums HWType
t then Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_ else do
      Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
      HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_))
  hdlSyn :: State VHDLState HdlSyn
hdlSyn          = Getting HdlSyn VHDLState HdlSyn -> State VHDLState HdlSyn
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting HdlSyn VHDLState HdlSyn
Lens' VHDLState HdlSyn
hdlsyn
  setModName :: Text -> VHDLState -> VHDLState
setModName Text
nm VHDLState
s = VHDLState
s {_modNm = nm}
  setTopName :: Identifier -> VHDLState -> VHDLState
setTopName Identifier
nm VHDLState
s = VHDLState
s {_topNm = nm}
  getTopName :: State VHDLState Identifier
getTopName      = Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
topNm
  setSrcSpan :: SrcSpan -> State VHDLState ()
setSrcSpan      = ((SrcSpan -> Identity SrcSpan) -> VHDLState -> Identity VHDLState
Lens' VHDLState SrcSpan
srcSpan .=)
  getSrcSpan :: State VHDLState SrcSpan
getSrcSpan      = Getting SrcSpan VHDLState SrcSpan -> State VHDLState SrcSpan
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting SrcSpan VHDLState SrcSpan
Lens' VHDLState SrcSpan
srcSpan
  blockDecl :: Identifier -> [Declaration] -> VHDLM Doc
blockDecl Identifier
nm [Declaration]
ds = do
    Doc
decs <- [Declaration] -> VHDLM Doc
decls [Declaration]
ds
    let attrs :: [(Identifier, Attr Text)]
attrs = [ (Identifier
id_, Attr Text
attr)
                | NetDecl' Maybe Text
_ Identifier
id_ HWType
hwtype Maybe Expr
_ <- [Declaration]
ds
                , Attr Text
attr <- HWType -> [Attr Text]
hwTypeAttrs HWType
hwtype]
    if Doc -> Bool
isEmpty Doc
decs
       then [Declaration] -> VHDLM Doc
insts [Declaration]
ds
       else Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
              (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"block" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
               Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
               (if [(Identifier, Attr Text)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr Text)]
attrs
                then VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                else VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Text -> [(Identifier, Attr Text)] -> VHDLM Doc
renderAttrs (String -> Text
TextS.pack String
"signal") [(Identifier, Attr Text)]
attrs)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> VHDLM Doc
insts [Declaration]
ds)
            VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            VHDLM Doc
"end block" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

  addIncludes :: [(String, Doc)] -> State VHDLState ()
addIncludes [(String, Doc)]
inc = ([(String, Doc)] -> Identity [(String, Doc)])
-> VHDLState -> Identity VHDLState
Lens' VHDLState [(String, Doc)]
includes (([(String, Doc)] -> Identity [(String, Doc)])
 -> VHDLState -> Identity VHDLState)
-> ([(String, Doc)] -> [(String, Doc)]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([(String, Doc)]
inc++)
  addLibraries :: [Text] -> State VHDLState ()
addLibraries [Text]
libs = ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Text]
libs ++)
  addImports :: [Text] -> State VHDLState ()
addImports [Text]
imps = ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
packages (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Text]
imps ++)
  addAndSetData :: String -> State VHDLState String
addAndSetData String
f = do
    [(String, String)]
fs <- Getting [(String, String)] VHDLState [(String, String)]
-> State VHDLState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VHDLState [(String, String)]
Lens' VHDLState [(String, String)]
dataFiles
    let ([(String, String)]
fs',String
f') = [(String, String)] -> String -> ([(String, String)], String)
renderFilePath [(String, String)]
fs String
f
    ([(String, String)] -> Identity [(String, String)])
-> VHDLState -> Identity VHDLState
Lens' VHDLState [(String, String)]
dataFiles (([(String, String)] -> Identity [(String, String)])
 -> VHDLState -> Identity VHDLState)
-> [(String, String)] -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(String, String)]
fs'
    String -> State VHDLState String
forall a. a -> StateT VHDLState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return String
f'
  getDataFiles :: State VHDLState [(String, String)]
getDataFiles = Getting [(String, String)] VHDLState [(String, String)]
-> State VHDLState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VHDLState [(String, String)]
Lens' VHDLState [(String, String)]
dataFiles
  addMemoryDataFile :: (String, String) -> State VHDLState ()
addMemoryDataFile (String, String)
f = ([(String, String)] -> Identity [(String, String)])
-> VHDLState -> Identity VHDLState
Lens' VHDLState [(String, String)]
memoryDataFiles (([(String, String)] -> Identity [(String, String)])
 -> VHDLState -> Identity VHDLState)
-> ([(String, String)] -> [(String, String)]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String, String)
f:)
  getMemoryDataFiles :: State VHDLState [(String, String)]
getMemoryDataFiles = Getting [(String, String)] VHDLState [(String, String)]
-> State VHDLState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VHDLState [(String, String)]
Lens' VHDLState [(String, String)]
memoryDataFiles
  ifThenElseExpr :: VHDLState -> Bool
ifThenElseExpr VHDLState
_ = Bool
False
  aggressiveXOptBB :: State VHDLState AggressiveXOptBB
aggressiveXOptBB = Getting AggressiveXOptBB VHDLState AggressiveXOptBB
-> State VHDLState AggressiveXOptBB
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting AggressiveXOptBB VHDLState AggressiveXOptBB
Lens' VHDLState AggressiveXOptBB
aggressiveXOptBB_
  renderEnums :: State VHDLState RenderEnums
renderEnums = Getting RenderEnums VHDLState RenderEnums
-> State VHDLState RenderEnums
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting RenderEnums VHDLState RenderEnums
Lens' VHDLState RenderEnums
renderEnums_
  domainConfigurations :: State VHDLState DomainMap
domainConfigurations = Getting DomainMap VHDLState DomainMap -> State VHDLState DomainMap
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting DomainMap VHDLState DomainMap
Lens' VHDLState DomainMap
domainConfigurations_
  setDomainConfigurations :: DomainMap -> VHDLState -> VHDLState
setDomainConfigurations DomainMap
confs VHDLState
s = VHDLState
s {_domainConfigurations_ = confs}

type VHDLM a = Ap (State VHDLState) a

-- Check if the underlying type is a BitVector
isBV :: RenderEnums -> HWType -> Bool
isBV :: RenderEnums -> HWType -> Bool
isBV RenderEnums
e (RenderEnums -> HWType -> HWType
normaliseType RenderEnums
e -> BitVector Int
_) = Bool
True
isBV RenderEnums
_ HWType
_ = Bool
False

-- | Generate unique (partial) names for product fields. Example:
--
-- > productFieldNames Nothing [Unsigned 6, Unsigned 6, Bit, Bool]
-- ["unsigned6_0", "unsigned6_1", "bit", "boolean"]
productFieldNames
  :: HasCallStack
  => Maybe [IdentifierText]
  -- ^ Label hints. From user records, for example.
  -> [HWType]
  -- ^ Field types
  -> VHDLM [IdentifierText]
productFieldNames :: HasCallStack => Maybe [Text] -> [HWType] -> VHDLM [Text]
productFieldNames Maybe [Text]
labels0 [HWType]
fields = do
  let labels1 :: [Maybe Text]
labels1 = Maybe [Text] -> [Maybe Text]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence Maybe [Text]
labels0 [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Maybe Text]
forall a. a -> [a]
repeat Maybe Text
forall a. Maybe a
Nothing
  [Text]
hFields <- (Maybe Text -> HWType -> Ap (State VHDLState) Text)
-> [Maybe Text] -> [HWType] -> VHDLM [Text]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe Text -> HWType -> Ap (State VHDLState) Text
hName [Maybe Text]
labels1 [HWType]
fields

  let grouped :: [[Text]]
grouped = [Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
group ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
hFields
      countGroup :: [a] -> (a, Int)
countGroup [] = String -> (a, Int)
forall a. HasCallStack => String -> a
error String
"productFIeldNames.countGroup: group of zero elements"
      countGroup (a
g:[a]
gs) = (a
g, Int -> Int
forall a. Enum a => a -> a
succ ([a] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [a]
gs))
      counted :: HashMap Text Int
counted = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMapS.fromList (([Text] -> (Text, Int)) -> [[Text]] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> (Text, Int)
forall {a}. [a] -> (a, Int)
countGroup [[Text]]
grouped)
      names :: [Text]
names   = (HashMap Text Int, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ((HashMap Text Int, [Text]) -> [Text])
-> (HashMap Text Int, [Text]) -> [Text]
forall a b. (a -> b) -> a -> b
$ (HashMap Text Int -> Text -> (HashMap Text Int, Text))
-> HashMap Text Int -> [Text] -> (HashMap Text Int, [Text])
forall (t :: Type -> Type) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (HashMap Text Int
-> HashMap Text Int -> Text -> (HashMap Text Int, Text)
name' HashMap Text Int
counted) HashMap Text Int
forall k v. HashMap k v
HashMapS.empty [Text]
hFields

  [Text] -> VHDLM [Text]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Text]
names
 where
  hName
    :: Maybe IdentifierText
    -> HWType
    -> VHDLM IdentifierText
  hName :: Maybe Text -> HWType -> Ap (State VHDLState) Text
hName Maybe Text
Nothing HWType
field = HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
False HWType
field
  hName (Just Text
label) HWType
_field = Identifier -> Text
Id.toText (Identifier -> Text)
-> Ap (State VHDLState) Identifier -> Ap (State VHDLState) Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Ap (State VHDLState) Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> m Identifier
Id.makeBasic Text
label

  name'
    :: HashMap IdentifierText Int
    -> HashMap IdentifierText Int
    -> IdentifierText
    -> (HashMap IdentifierText Int, IdentifierText)
  name' :: HashMap Text Int
-> HashMap Text Int -> Text -> (HashMap Text Int, Text)
name' HashMap Text Int
counted HashMap Text Int
countMap Text
fieldName
    | HashMap Text Int
counted HashMap Text Int -> Text -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMapS.! Text
fieldName Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
        -- Seen this fieldname more than once, so we need to add a number
        -- as a postfix:
        let succ' :: Maybe Int -> Maybe Int
succ' Maybe Int
n = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
0 :: Int) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Maybe Int
n) in
        let countMap' :: HashMap Text Int
countMap' = (Maybe Int -> Maybe Int)
-> Text -> HashMap Text Int -> HashMap Text Int
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMapS.alter Maybe Int -> Maybe Int
succ' Text
fieldName HashMap Text Int
countMap in
        -- Each field will get a distinct number:
        let count :: Int
count = HashMap Text Int
countMap' HashMap Text Int -> Text -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMapS.! Text
fieldName in
        (HashMap Text Int
countMap', [Text] -> Text
TextS.concat [Text
fieldName, Text
"_", Int -> Text
forall a. Show a => a -> Text
showt Int
count])
    | Bool
otherwise =
        -- This fieldname has only been seen once, so we don't need to add
        -- a number as a postfix:
        (HashMap Text Int
countMap, Text
fieldName)

productFieldName
  :: HasCallStack
  => Maybe [IdentifierText]
  -- ^ Label hints. From user records, for example.
  -> [HWType]
  -- ^ Field types
  -> Int
  -- ^ Index of field
  -> VHDLM Doc
productFieldName :: HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
productFieldName Maybe [Text]
labels [HWType]
fields Int
fieldIndex = do
  [Text]
names <-
    (Maybe [Text], [HWType])
-> Lens' VHDLState (HashMap (Maybe [Text], [HWType]) [Text])
-> VHDLM [Text]
-> VHDLM [Text]
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached
      (Maybe [Text]
labels, [HWType]
fields)
      (HashMap (Maybe [Text], [HWType]) [Text]
 -> f (HashMap (Maybe [Text], [HWType]) [Text]))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (Maybe [Text], [HWType]) [Text])
productFieldNameCache
      (HasCallStack => Maybe [Text] -> [HWType] -> VHDLM [Text]
Maybe [Text] -> [HWType] -> VHDLM [Text]
productFieldNames Maybe [Text]
labels [HWType]
fields)
  Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Doc
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty ([Text]
names [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
fieldIndex))

selectProductField
  :: HasCallStack
  => Maybe [IdentifierText]
  -- ^ Label hints. From user records, for example.
  -> [HWType]
  -- ^ Field types
  -> Int
  -- ^ Index of field
  -> VHDLM Doc
selectProductField :: HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
fieldLabels [HWType]
fieldTypes Int
fieldIndex =
  VHDLM Doc
"_sel" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fieldIndex VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
productFieldName Maybe [Text]
fieldLabels [HWType]
fieldTypes Int
fieldIndex

enumVariantName
  :: HasCallStack
  => HWType
  -> Int
  -> VHDLM Doc
enumVariantName :: HasCallStack => HWType -> Int -> VHDLM Doc
enumVariantName ty :: HWType
ty@(Sum Text
_ [Text]
vs) Int
i = do
  [Text]
names <- HWType
-> Lens' VHDLState (HashMap HWType [Text])
-> VHDLM [Text]
-> VHDLM [Text]
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached HWType
ty (HashMap HWType [Text] -> f (HashMap HWType [Text]))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap HWType [Text])
enumNameCache ((Text -> Ap (State VHDLState) Text) -> [Text] -> VHDLM [Text]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Ap (State VHDLState) Text
variantName [Text]
vs)
  Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> Doc
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty ([Text]
names [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
i))
 where
  -- Make a basic identifier from the last part of a qualified name
  variantName :: Text -> Ap (State VHDLState) Text
variantName = (Identifier -> Text)
-> Ap (State VHDLState) Identifier -> Ap (State VHDLState) Text
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Text
Id.toText (Ap (State VHDLState) Identifier -> Ap (State VHDLState) Text)
-> (Text -> Ap (State VHDLState) Identifier)
-> Text
-> Ap (State VHDLState) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Ap (State VHDLState) Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> m Identifier
Id.makeBasic (Text -> Ap (State VHDLState) Identifier)
-> (Text -> Text) -> Text -> Ap (State VHDLState) Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
TextS.breakOnEnd Text
"."

enumVariantName HWType
_ Int
_ =
  String -> VHDLM Doc
forall a. HasCallStack => String -> a
error (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"enumVariantName called on non-enum type"

-- | Generate VHDL for a Netlist component
genVHDL
  :: ClashOpts
  -> ModName
  -> SrcSpan
  -> IdentifierSet
  -> UsageMap
  -> Component
  -> VHDLM ((String, Doc), [(String, Doc)])
genVHDL :: ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL ClashOpts
_ Text
nm SrcSpan
sp IdentifierSet
seen UsageMap
us Component
c = do
    -- Don't have type names conflict with module names or with previously
    -- generated type names.
    --
    -- TODO: Collect all type names up front, to prevent relatively costly union.
    -- TODO: Investigate whether type names / signal names collide in the first place
    State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState () -> Ap (State VHDLState) ())
-> State VHDLState () -> Ap (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ do
      (IdentifierSet -> Identity IdentifierSet)
-> VHDLState -> Identity VHDLState
Lens' VHDLState IdentifierSet
idSeen ((IdentifierSet -> Identity IdentifierSet)
 -> VHDLState -> Identity VHDLState)
-> (IdentifierSet -> IdentifierSet) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HasCallStack => IdentifierSet -> IdentifierSet -> IdentifierSet
IdentifierSet -> IdentifierSet -> IdentifierSet
Id.union IdentifierSet
seen
      (UsageMap -> Identity UsageMap) -> VHDLState -> Identity VHDLState
Lens' VHDLState UsageMap
usages ((UsageMap -> Identity UsageMap)
 -> VHDLState -> Identity VHDLState)
-> UsageMap -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UsageMap
us
      SrcSpan -> State VHDLState ()
forall state. Backend state => SrcSpan -> State state ()
setSrcSpan SrcSpan
sp

    Doc
v <- VHDLM Doc
vhdl
    [(String, Doc)]
i <- State VHDLState [(String, Doc)]
-> Ap (State VHDLState) [(String, Doc)]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState [(String, Doc)]
 -> Ap (State VHDLState) [(String, Doc)])
-> State VHDLState [(String, Doc)]
-> Ap (State VHDLState) [(String, Doc)]
forall a b. (a -> b) -> a -> b
$ Getting [(String, Doc)] VHDLState [(String, Doc)]
-> State VHDLState [(String, Doc)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, Doc)] VHDLState [(String, Doc)]
Lens' VHDLState [(String, Doc)]
includes
    State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState () -> Ap (State VHDLState) ())
-> State VHDLState () -> Ap (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> [Text] -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= []
    State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState () -> Ap (State VHDLState) ())
-> State VHDLState () -> Ap (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
packages  (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> [Text] -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= []
    ((String, Doc), [(String, Doc)])
-> Ap (State VHDLState) ((String, Doc), [(String, Doc)])
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((Text -> String
TextS.unpack (Identifier -> Text
Id.toText Identifier
cName), Doc
v), [(String, Doc)]
i)
  where
    cName :: Identifier
cName   = Component -> Identifier
componentName Component
c
    vhdl :: VHDLM Doc
vhdl    = do
      Doc
ent  <- Component -> VHDLM Doc
entity Component
c
      Doc
arch <- Component -> VHDLM Doc
architecture Component
c
      Doc
imps <- Text -> VHDLM Doc
tyImports Text
nm
      (VHDLM Doc
"-- Automatically generated VHDL-93" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
       Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
imps VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
       Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
ent VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
       Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
arch)

-- | Generate a VHDL package containing type definitions for the given HWTypes
mkTyPackage_ :: ModName -> [HWType] -> VHDLM [(String,Doc)]
mkTyPackage_ :: Text -> [HWType] -> Ap (State VHDLState) [(String, Doc)]
mkTyPackage_ Text
modName ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent -> [HWType]
hwtys) = do
    { State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((Bool -> Identity Bool) -> VHDLState -> Identity VHDLState
Lens' VHDLState Bool
tyPkgCtx ((Bool -> Identity Bool) -> VHDLState -> Identity VHDLState)
-> Bool -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True)
    ; HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    ; RenderEnums
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
    ; let usedTys :: [HWType]
usedTys     = (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
hwtys
    ; let normTys0 :: [HWType]
normTys0    = [HWType] -> [HWType]
forall a. Eq a => [a] -> [a]
nub ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
mkVecZ ([HWType]
hwtys [HWType] -> [HWType] -> [HWType]
forall a. [a] -> [a] -> [a]
++ [HWType]
usedTys))
    ; let sortedTys0 :: [HWType]
sortedTys0  = [HWType] -> [HWType]
topSortHWTys [HWType]
normTys0
          packageDec :: VHDLM Doc
packageDec  = Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ (HWType -> VHDLM Doc) -> [HWType] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
tyDec ((HWType -> HWType -> Bool) -> [HWType] -> [HWType]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy HWType -> HWType -> Bool
eqTypM [HWType]
sortedTys0)
          ([VHDLM Doc]
funDecs,[VHDLM Doc]
funBodies) = [(VHDLM Doc, VHDLM Doc)] -> ([VHDLM Doc], [VHDLM Doc])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(VHDLM Doc, VHDLM Doc)] -> ([VHDLM Doc], [VHDLM Doc]))
-> ([HWType] -> [(VHDLM Doc, VHDLM Doc)])
-> [HWType]
-> ([VHDLM Doc], [VHDLM Doc])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWType -> Maybe (VHDLM Doc, VHDLM Doc))
-> [HWType] -> [(VHDLM Doc, VHDLM Doc)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (RenderEnums -> HdlSyn -> HWType -> Maybe (VHDLM Doc, VHDLM Doc)
funDec RenderEnums
enums HdlSyn
syn) ([HWType] -> ([VHDLM Doc], [VHDLM Doc]))
-> [HWType] -> ([VHDLM Doc], [VHDLM Doc])
forall a b. (a -> b) -> a -> b
$ (HWType -> HWType -> Bool) -> [HWType] -> [HWType]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy HWType -> HWType -> Bool
eqTypM (RenderEnums -> HWType -> HWType
normaliseType RenderEnums
enums (HWType -> HWType) -> [HWType] -> [HWType]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [HWType]
sortedTys0)

    ; [(String, Doc)]
pkg <- ((String, Doc) -> [(String, Doc)] -> [(String, Doc)]
forall a. a -> [a] -> [a]
:[]) ((String, Doc) -> [(String, Doc)])
-> (Doc -> (String, Doc)) -> Doc -> [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> String
TextS.unpack (Text
modName Text -> Text -> Text
`TextS.append` Text
"_types"),) (Doc -> [(String, Doc)])
-> VHDLM Doc -> Ap (State VHDLState) [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
      VHDLM Doc
"library IEEE;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"use IEEE.STD_LOGIC_1164.ALL;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"use IEEE.NUMERIC_STD.ALL;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"package" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text
modName Text -> Text -> Text
`TextS.append` Text
"_types") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ( VHDLM Doc
packageDec VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
                    Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc]
funDecs)
                  ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> [VHDLM Doc] -> VHDLM Doc
packageBodyDec [VHDLM Doc]
funBodies
    ; State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((Bool -> Identity Bool) -> VHDLState -> Identity VHDLState
Lens' VHDLState Bool
tyPkgCtx ((Bool -> Identity Bool) -> VHDLState -> Identity VHDLState)
-> Bool -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False)
    ; [(String, Doc)] -> Ap (State VHDLState) [(String, Doc)]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [(String, Doc)]
pkg
    }
  where
    packageBodyDec :: [VHDLM Doc] -> VHDLM Doc
    packageBodyDec :: [VHDLM Doc] -> VHDLM Doc
packageBodyDec [VHDLM Doc]
funBodies = case [VHDLM Doc]
funBodies of
      [] -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      [VHDLM Doc]
_  -> do
        { VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"package" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"body" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text
modName Text -> Text -> Text
`TextS.append` Text
"_types") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
           Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc]
funBodies)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        }

    eqTypM :: HWType -> HWType -> Bool
    eqTypM :: HWType -> HWType -> Bool
eqTypM (Signed Int
_) (Signed Int
_)         = Bool
True
    eqTypM (Unsigned Int
_) (Unsigned Int
_)     = Bool
True
    eqTypM (BitVector Int
_) (BitVector Int
_)   = Bool
True
    eqTypM HWType
ty1 HWType
ty2                       = HWType
ty1 HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
ty2

mkUsedTys :: HWType -> [HWType]
mkUsedTys :: HWType -> [HWType]
mkUsedTys HWType
hwty = HWType
hwty HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: case HWType
hwty of
  Vector Int
_ HWType
elTy        -> HWType -> [HWType]
mkUsedTys HWType
elTy
  RTree Int
_ HWType
elTy         -> HWType -> [HWType]
mkUsedTys HWType
elTy
  Product Text
_ Maybe [Text]
_ [HWType]
elTys    -> (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
elTys
  SP Text
_ [(Text, [HWType])]
elTys           -> (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Text, [HWType])]
elTys)
  BiDirectional PortDirection
_ HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
  Annotated [Attr Text]
_ HWType
elTy     -> HWType -> [HWType]
mkUsedTys HWType
elTy
  CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ [(Integer, HWType)]
tys0 ->
    (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd [(Integer, HWType)]
tys0)
  CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
tys0 ->
    let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (ConstrRepr'
_repr, Text
_id, [HWType]
tys) <- [(ConstrRepr', Text, [HWType])]
tys0] in
    (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
tys1
  HWType
_ ->
    []

topSortHWTys
  :: [HWType]
  -> [HWType]
topSortHWTys :: [HWType] -> [HWType]
topSortHWTys [HWType]
hwtys = [HWType]
sorted
  where
    nodes :: [(Unique, HWType)]
nodes  = [Unique] -> [HWType] -> [(Unique, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Unique
0..] [HWType]
hwtys
    nodesI :: HashMap HWType Unique
nodesI = [(HWType, Unique)] -> HashMap HWType Unique
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([HWType] -> [Unique] -> [(HWType, Unique)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
hwtys [Unique
0..])
    edges :: [(Unique, Unique)]
edges  = (HWType -> [(Unique, Unique)]) -> [HWType] -> [(Unique, Unique)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [(Unique, Unique)]
edge [HWType]
hwtys

    sorted :: [HWType]
sorted =
      case [(Unique, HWType)] -> [(Unique, Unique)] -> Either String [HWType]
forall a. [(Unique, a)] -> [(Unique, Unique)] -> Either String [a]
reverseTopSort [(Unique, HWType)]
nodes [(Unique, Unique)]
edges of
        Left String
err -> String -> [HWType]
forall a. HasCallStack => String -> a
error (String -> [HWType]) -> String -> [HWType]
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[BUG IN CLASH] topSortHWTys: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        Right [HWType]
ns -> [HWType]
ns

    -- `elTy` needs to be rendered before `t`
    edge :: HWType -> [(Unique, Unique)]
edge t :: HWType
t@(Vector Int
_ HWType
elTy) =
      case HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
elTy) HashMap HWType Unique
nodesI of
        Just Unique
node ->
          [(HashMap HWType Unique
nodesI HashMap HWType Unique -> HWType -> Unique
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t, Unique
node)]
        Maybe Unique
Nothing ->
          []

    -- `elTy` needs to be rendered before `t`
    edge t :: HWType
t@(RTree Int
_ HWType
elTy) =
      let vecZ :: HWType
vecZ = HWType -> HWType
mkVecZ HWType
elTy in
      case HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
vecZ HashMap HWType Unique
nodesI of
        Just Unique
node ->
          [(HashMap HWType Unique
nodesI HashMap HWType Unique -> HWType -> Unique
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t, Unique
node)] [(Unique, Unique)] -> [(Unique, Unique)] -> [(Unique, Unique)]
forall a. [a] -> [a] -> [a]
++ HWType -> [(Unique, Unique)]
edge HWType
elTy
        Maybe Unique
Nothing ->
          []

    -- `tys` need to be rendered before `t`
    edge t :: HWType
t@(Product Text
_ Maybe [Text]
_ [HWType]
tys0) =
      let tys1 :: [Maybe Unique]
tys1 = [HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Unique
nodesI | HWType
ty <- [HWType]
tys0] in
      (Unique -> (Unique, Unique)) -> [Unique] -> [(Unique, Unique)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Unique
nodesI HashMap HWType Unique -> HWType -> Unique
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Unique] -> [Unique]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Unique]
tys1)

    edge t :: HWType
t@(SP Text
_ [(Text, [HWType])]
tys0) =
      let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat (((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [[HWType]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Text, [HWType])]
tys0) in
      let tys2 :: [Maybe Unique]
tys2 = [HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Unique
nodesI | HWType
ty <- [HWType]
tys1] in
      (Unique -> (Unique, Unique)) -> [Unique] -> [(Unique, Unique)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Unique
nodesI HashMap HWType Unique -> HWType -> Unique
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Unique] -> [Unique]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Unique]
tys2)

    edge t :: HWType
t@(CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
tys0) =
      let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (ConstrRepr'
_repr, Text
_id, [HWType]
tys) <- [(ConstrRepr', Text, [HWType])]
tys0] in
      let tys2 :: [Maybe Unique]
tys2 = [HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Unique
nodesI | HWType
ty <- [HWType]
tys1] in
      (Unique -> (Unique, Unique)) -> [Unique] -> [(Unique, Unique)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Unique
nodesI HashMap HWType Unique -> HWType -> Unique
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Unique] -> [Unique]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Unique]
tys2)

    edge t :: HWType
t@(CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ (((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd -> [HWType]
tys0)) =
      let tys1 :: [Maybe Unique]
tys1 = [HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Unique
nodesI | HWType
ty <- [HWType]
tys0] in
      (Unique -> (Unique, Unique)) -> [Unique] -> [(Unique, Unique)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Unique
nodesI HashMap HWType Unique -> HWType -> Unique
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Unique] -> [Unique]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Unique]
tys1)

    edge HWType
_ = []

mkVecZ :: HWType -> HWType
mkVecZ :: HWType -> HWType
mkVecZ (Vector Int
_ HWType
elTy) = Int -> HWType -> HWType
Vector Int
0 HWType
elTy
mkVecZ (RTree Int
_ HWType
elTy)  = Int -> HWType -> HWType
RTree Int
0 HWType
elTy
mkVecZ HWType
t               = HWType
t

typAliasDec :: HasCallStack => HWType -> VHDLM Doc
typAliasDec :: HasCallStack => HWType -> VHDLM Doc
typAliasDec HWType
hwty = do
  RenderEnums
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  VHDLM Doc
"subtype" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty
            VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is"
            VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedTyName (RenderEnums -> HWType -> HWType
normaliseType RenderEnums
enums HWType
hwty)
            VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

tyDec :: HasCallStack => HWType -> VHDLM Doc
tyDec :: HasCallStack => HWType -> VHDLM Doc
tyDec HWType
hwty = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums

  case HWType
hwty of
    -- "Proper" custom types:
    Vector Int
_ HWType
elTy ->
      case HdlSyn
syn of
        HdlSyn
Vivado ->
          VHDLM Doc
"type" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is array (integer range <>) of std_logic_vector"
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto 0")
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

        HdlSyn
_ ->
          VHDLM Doc
"type" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is array (integer range <>) of"
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
elTy
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

    RTree Int
_ HWType
elTy ->
      case HdlSyn
syn of
        HdlSyn
Vivado ->
          VHDLM Doc
"type" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is array (integer range <>) of"
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector"
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto 0")
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

        HdlSyn
_ ->
          VHDLM Doc
"type" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is array (integer range <>) of"
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
elTy
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

    Product Text
_ Maybe [Text]
labels tys :: [HWType]
tys@(HWType
_:HWType
_:[HWType]
_) ->
      let selNames :: [VHDLM Doc]
selNames = (Int -> VHDLM Doc) -> [Int] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> HWType -> VHDLM Doc
tyName HWType
hwty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
i) [Int
0..] in
      let selTys :: [VHDLM Doc]
selTys   = (HWType -> VHDLM Doc) -> [HWType] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> VHDLM Doc
sizedQualTyName [HWType]
tys in
      VHDLM Doc
"type" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is record" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line  VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ (VHDLM Doc -> VHDLM Doc -> VHDLM Doc)
-> [VHDLM Doc] -> [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\VHDLM Doc
x VHDLM Doc
y -> VHDLM Doc
x VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
y VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) [VHDLM Doc]
selNames [VHDLM Doc]
selTys) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"end record" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

    Sum Text
_ [Text]
vs | Bool
enums ->
        let variantNames :: Ap (State VHDLState) [Doc]
variantNames = (Int -> VHDLM Doc) -> [Int] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (HasCallStack => HWType -> Int -> VHDLM Doc
HWType -> Int -> VHDLM Doc
enumVariantName HWType
hwty) [Int
0..[Text] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Text]
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] in
          VHDLM Doc
"type" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
hwty
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is"
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hsep (VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Ap (State VHDLState) [Doc]
variantNames))
                 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

    MemBlob Int
n Int
m -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
tyDec (Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m))

    -- Type aliases:
    Clock Text
_           -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    ClockN Text
_          -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    Reset Text
_           -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    Enable Text
_          -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    Index Integer
_           -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_  -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    Sum Text
_ [Text]
_           -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    SP Text
_ [(Text, [HWType])]
_            -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_ -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty
    CustomProduct {}  -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
typAliasDec HWType
hwty

    -- VHDL builtin types:
    BitVector Int
_ -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    HWType
Bool        -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    HWType
Bit         -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Unsigned Int
_  -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Signed Int
_    -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    HWType
String      -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    HWType
Integer     -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    HWType
FileType    -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

    -- Transparent types:
    BiDirectional PortDirection
_ HWType
ty -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
tyDec HWType
ty
    Annotated [Attr Text]
_ HWType
ty -> HasCallStack => HWType -> VHDLM Doc
HWType -> VHDLM Doc
tyDec HWType
ty

    Void {} -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    KnownDomain {} -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

    -- Unexpected arguments:
    Product Text
_ Maybe [Text]
_ [HWType]
_ -> String -> VHDLM Doc
forall a. HasCallStack => String -> a
error (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [I.i|
      Unexpected Product with fewer than 2 fields: #{hwty}
    |]




funDec :: RenderEnums -> HdlSyn -> HWType -> Maybe (VHDLM Doc,VHDLM Doc)
funDec :: RenderEnums -> HdlSyn -> HWType -> Maybe (VHDLM Doc, VHDLM Doc)
funDec RenderEnums
_ HdlSyn
_ HWType
Bool = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"b" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"sl" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"tagToEnum" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"s" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"dataToTag" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"b" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"b" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"b" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"then"
                                ,  Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"else"
                                ,  Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                                ]) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"sl" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"sl" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"then"
                                ,   Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"true" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"else"
                                ,   Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"false" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                                ]) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"tagToEnum" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"s" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"s" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> (State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth) Ap (State VHDLState) Int -> (Int -> VHDLM Doc) -> VHDLM Doc
forall a b.
Ap (State VHDLState) a
-> (a -> Ap (State VHDLState) b) -> Ap (State VHDLState) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"then"
                                ,   Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"false" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"else"
                                ,   Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"true" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                                ]) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"dataToTag" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"b" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"boolean") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"b" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"then"
                                ,  Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> (State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth) Ap (State VHDLState) Int -> (Int -> VHDLM Doc) -> VHDLM Doc
forall a b.
Ap (State VHDLState) a
-> (a -> Ap (State VHDLState) b) -> Ap (State VHDLState) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"else"
                                ,  Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> (State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth) Ap (State VHDLState) Int -> (Int -> VHDLM Doc) -> VHDLM Doc
forall a b.
Ap (State VHDLState) a
-> (a -> Ap (State VHDLState) b) -> Ap (State VHDLState) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
                                ,VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                                ]) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )

funDec RenderEnums
_ HdlSyn
_ bit :: HWType
bit@HWType
Bit = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"sl" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
bit) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
bit VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"sl" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
bit) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"sl") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
bit VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        ( VHDLM Doc
"alias islv : std_logic_vector (0 to slv'length - 1) is slv;"
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"islv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )

funDec RenderEnums
_ HdlSyn
_ (Signed Int
_) = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"s" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"s" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"s") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"islv") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )

funDec RenderEnums
_ HdlSyn
_ (Unsigned Int
_) = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"u" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"unsigned") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"u" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"unsigned") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is"  VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"u") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is"  VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 VHDLM Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"islv") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

  )

funDec RenderEnums
_ HdlSyn
_ t :: HWType
t@(Product Text
_ Maybe [Text]
labels [HWType]
elTys) = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"p :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"p :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & " Ap (State VHDLState) [Doc]
elTyToSLV)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
"," Ap (State VHDLState) [Doc]
elTyFromSLV)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )
  where
    elTyToSLV :: Ap (State VHDLState) [Doc]
elTyToSLV = [Int] -> (Int -> VHDLM Doc) -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..([HWType] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
elTys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                     (\Int
i -> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
                            VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"p." VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> VHDLM Doc
tyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
labels [HWType]
elTys Int
i))

    argLengths :: [Int]
argLengths = (HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
elTys
    starts1 :: [Int]
starts1    = (Int, [Int]) -> [Int]
forall a b. (a, b) -> b
snd ((Int -> Int -> (Int, Int)) -> Int -> [Int] -> (Int, [Int])
forall (t :: Type -> Type) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (((Int -> Int -> (Int, Int)) -> Int -> (Int, Int)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (,) .) ((Int -> Int) -> Int -> (Int, Int))
-> (Int -> Int -> Int) -> Int -> Int -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)) Int
0 [Int]
argLengths)
    starts :: [Int]
starts     = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
starts1
    ends :: [Int]
ends       = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) [Int]
starts1

    elTyFromSLV :: Ap (State VHDLState) [Doc]
elTyFromSLV = [(Int, Int)]
-> ((Int, Int) -> VHDLM Doc) -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
starts [Int]
ends)
                       (\(Int
s,Int
e) -> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
                          VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"islv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)))

funDec (RenderEnums Bool
enums) HdlSyn
_ t :: HWType
t@(Sum Text
_ [Text]
_) | Bool
enums = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens(VHDLM Doc
"value" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"value" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
      ( VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
        VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"to_unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
          VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'pos(value)" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t))
        )) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
      (
      VHDLM Doc -> VHDLM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
f Doc -> f Doc
translate_off (
      VHDLM Doc
"if unsigned(slv) <= " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'pos("VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'high) then"
      ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
          ( VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'val" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"to_integer" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
              VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
"slv"))) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc -> VHDLM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
f Doc -> f Doc
translate_off (
        VHDLM Doc
"else" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
          ( VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'val(0)") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
        VHDLM Doc
"end if" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      )
      ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )
  where
    translate_off :: f Doc -> f Doc
translate_off f Doc
body = f Doc
"-- pragma translate_off" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
line f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
body f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
line f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
"-- pragma translate_on"

funDec RenderEnums
_ HdlSyn
syn t :: HWType
t@(Vector Int
_ HWType
elTy) = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"value : " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"value : " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        ( VHDLM Doc
"alias ivalue    :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"(1 to value'length) is value;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
          VHDLM Doc
"variable result :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"1 to value'length * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        (VHDLM Doc
"for i in ivalue'range loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
              (  VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"(i - 1) * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"+ 1" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                                             VHDLM Doc
"to i*" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                          VHDLM Doc
":=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (case HdlSyn
syn of
                                      HdlSyn
Vivado -> VHDLM Doc
"ivalue" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"i")
                                      HdlSyn
_  -> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"ivalue" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"i"))) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
              ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        ( VHDLM Doc
"alias islv      :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"(0 to slv'length - 1) is slv;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
          VHDLM Doc
"variable result :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"0 to slv'length / " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
eSz VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"- 1") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        (VHDLM Doc
"for i in result'range loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
              ( VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
"i" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
":=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> case HdlSyn
syn of
                    HdlSyn
Vivado -> VHDLM Doc
getElem VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                    HdlSyn
_ | BitVector Int
_ <- HWType
elTy -> VHDLM Doc
getElem VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                      | Bool
otherwise           -> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
getElem VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

              ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )
  where
    eSz :: VHDLM Doc
eSz     = Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)
    getElem :: VHDLM Doc
getElem = VHDLM Doc
"islv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"i * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
eSz VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to (i+1) * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
eSz VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"- 1")

funDec RenderEnums
_ HdlSyn
_ (BitVector Int
_) = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )

funDec RenderEnums
_ HdlSyn
syn t :: HWType
t@(RTree Int
_ HWType
elTy) = (VHDLM Doc, VHDLM Doc) -> Maybe (VHDLM Doc, VHDLM Doc)
forall a. a -> Maybe a
Just
  ( VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"value : " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"value : " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        ( VHDLM Doc
"alias ivalue    :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"(1 to value'length) is value;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
          VHDLM Doc
"variable result :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"1 to value'length * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        (VHDLM Doc
"for i in ivalue'range loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
              (  VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"(i - 1) * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"+ 1" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                                             VHDLM Doc
"to i*" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                          VHDLM Doc
":=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (case HdlSyn
syn of
                                      HdlSyn
Vivado -> VHDLM Doc
"ivalue" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"i")
                                      HdlSyn
_ -> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"ivalue" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"i"))) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
              ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"function" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"slv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"in" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        ( VHDLM Doc
"alias islv      :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"(0 to slv'length - 1) is slv;" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
          VHDLM Doc
"variable result :" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"0 to slv'length / " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
eSz VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"- 1") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
        (VHDLM Doc
"for i in result'range loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
              ( VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
"i" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
":=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> case HdlSyn
syn of
                    HdlSyn
Vivado -> VHDLM Doc
getElem VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                    HdlSyn
_ | BitVector Int
_ <- HWType
elTy -> VHDLM Doc
getElem VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                      | Bool
otherwise           -> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
getElem VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

              ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"loop" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
         VHDLM Doc
"return" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"result" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
        ) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )
  where
    eSz :: VHDLM Doc
eSz     = Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)
    getElem :: VHDLM Doc
getElem = VHDLM Doc
"islv" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"i * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
eSz VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to (i+1) * " VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
eSz VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"- 1")

funDec RenderEnums
_ HdlSyn
_ HWType
_ = Maybe (VHDLM Doc, VHDLM Doc)
forall a. Maybe a
Nothing

tyImports :: ModName -> VHDLM Doc
tyImports :: Text -> VHDLM Doc
tyImports Text
nm = do
  [Text]
libs <- State VHDLState [Text] -> Ap (State VHDLState) [Text]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState [Text] -> Ap (State VHDLState) [Text])
-> State VHDLState [Text] -> Ap (State VHDLState) [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] VHDLState [Text] -> State VHDLState [Text]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Text] VHDLState [Text]
Lens' VHDLState [Text]
libraries
  [Text]
packs <- State VHDLState [Text] -> Ap (State VHDLState) [Text]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState [Text] -> Ap (State VHDLState) [Text])
-> State VHDLState [Text] -> Ap (State VHDLState) [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] VHDLState [Text] -> State VHDLState [Text]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Text] VHDLState [Text]
Lens' VHDLState [Text]
packages
  VHDLM Doc -> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (m :: Type -> Type).
Monad m =>
Ap m Doc -> Ap m [Doc] -> Ap m Doc
punctuate' VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence
    ([ VHDLM Doc
"library IEEE"
     , VHDLM Doc
"use IEEE.STD_LOGIC_1164.ALL"
     , VHDLM Doc
"use IEEE.NUMERIC_STD.ALL"
     , VHDLM Doc
"use IEEE.MATH_REAL.ALL"
     , VHDLM Doc
"use std.textio.all"
     , VHDLM Doc
"use work.all"
     , VHDLM Doc
"use work." VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text
nm Text -> Text -> Text
`TextS.append` Text
"_types") VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
".all"
     ] [VHDLM Doc] -> [VHDLM Doc] -> [VHDLM Doc]
forall a. [a] -> [a] -> [a]
++ ((Text -> VHDLM Doc) -> [Text] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((VHDLM Doc
"library" <+>) (VHDLM Doc -> VHDLM Doc)
-> (Text -> VHDLM Doc) -> Text -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
libs))
       [VHDLM Doc] -> [VHDLM Doc] -> [VHDLM Doc]
forall a. [a] -> [a] -> [a]
++ ((Text -> VHDLM Doc) -> [Text] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((VHDLM Doc
"use" <+>) (VHDLM Doc -> VHDLM Doc)
-> (Text -> VHDLM Doc) -> Text -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
packs)))


-- TODO: Way too much happening on a single line
port :: Num t
     => Identifier
     -> HWType
     -> VHDLM Doc
     -> Int
     -> Maybe Expr
     -> VHDLM (Doc, t)
port :: forall t.
Num t =>
Identifier
-> HWType -> VHDLM Doc -> Int -> Maybe Expr -> VHDLM (Doc, t)
port (Identifier -> Text
Id.toText -> Text
elName) HWType
hwType VHDLM Doc
portDirection Int
fillToN Maybe Expr
iEM =
  (,Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$ Text -> Int
TextS.length Text
elName) (Doc -> (Doc, t)) -> VHDLM Doc -> Ap (State VHDLState) (Doc, t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (HWType -> VHDLM Doc
encodingNote HWType
hwType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill Int
fillToN (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
elName) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
direction
   VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
hwType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
iE)
 where
  direction :: VHDLM Doc
direction | HWType -> Bool
isBiSignalIn HWType
hwType = VHDLM Doc
"inout"
            | Bool
otherwise           = VHDLM Doc
portDirection

  iE :: VHDLM Doc
iE = VHDLM Doc -> (Expr -> VHDLM Doc) -> Maybe Expr -> VHDLM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (VHDLM Doc -> VHDLM Doc
noEmptyInit (VHDLM Doc -> VHDLM Doc)
-> (Expr -> VHDLM Doc) -> Expr -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False) Maybe Expr
iEM

-- [Note] Hack entity attributes in architecture
--
-- By default we print attributes inside the entity block. This conforms
-- to the VHDL standard (IEEE Std 1076-1993, 5.1 Attribute specification,
-- paragraph 9), and is subsequently implemented in this way by open-source
-- simulators such as GHDL.
---
-- Intel and Xilinx use their own annotation schemes unfortunately, which
-- require attributes in the architecture.
--
-- References:
--  * https://www.mail-archive.com/ghdl-discuss@gna.org/msg03175.html
--  * https://forums.xilinx.com/t5/Simulation-and-Verification/wrong-attribute-decorations-of-port-signals-generated-by-write/m-p/704905#M16265
--  * http://quartushelp.altera.com/15.0/mergedProjects/hdl/vhdl/vhdl_file_dir_chip.htm

entity :: Component -> VHDLM Doc
entity :: Component -> VHDLM Doc
entity Component
c = do
    HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Int -> Ap (State VHDLState) [(Doc, Int)]
ports ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls))
    VHDLM Doc
"entity" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      (case [Doc]
p of
         [] -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
         [Doc]
_  -> case HdlSyn
syn of
          -- See: [Note] Hack entity attributes in architecture
          HdlSyn
Other -> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Doc] -> VHDLM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
[Doc] -> f Doc
rports [Doc]
p VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> if [(Identifier, Attr Text)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr Text)]
attrs then VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else
                              VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
rattrs) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
          HdlSyn
_     -> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Doc] -> VHDLM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
[Doc] -> f Doc
rports [Doc]
p) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      )
  where
    ports :: Int -> Ap (State VHDLState) [(Doc, Int)]
ports Int
l = [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence ([Ap (State VHDLState) (Doc, Int)]
 -> Ap (State VHDLState) [(Doc, Int)])
-> [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall a b. (a -> b) -> a -> b
$ [Identifier
-> HWType
-> VHDLM Doc
-> Int
-> Maybe Expr
-> Ap (State VHDLState) (Doc, Int)
forall t.
Num t =>
Identifier
-> HWType -> VHDLM Doc -> Int -> Maybe Expr -> VHDLM (Doc, t)
port Identifier
iName HWType
hwType VHDLM Doc
"in" Int
l Maybe Expr
forall a. Maybe a
Nothing | (Identifier
iName, HWType
hwType) <- Component -> [(Identifier, HWType)]
inputs Component
c]
                      [Ap (State VHDLState) (Doc, Int)]
-> [Ap (State VHDLState) (Doc, Int)]
-> [Ap (State VHDLState) (Doc, Int)]
forall a. [a] -> [a] -> [a]
++ [Identifier
-> HWType
-> VHDLM Doc
-> Int
-> Maybe Expr
-> Ap (State VHDLState) (Doc, Int)
forall t.
Num t =>
Identifier
-> HWType -> VHDLM Doc -> Int -> Maybe Expr -> VHDLM (Doc, t)
port Identifier
oName HWType
hwType VHDLM Doc
"out" Int
l Maybe Expr
iEM | (Usage
_, (Identifier
oName, HWType
hwType), Maybe Expr
iEM) <- Component -> [(Usage, (Identifier, HWType), Maybe Expr)]
outputs Component
c]

    rports :: [Doc] -> f Doc
rports [Doc]
p = f Doc
"port" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> (f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (f [Doc] -> f Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (f Doc -> f [Doc] -> f [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate f Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> f [Doc]
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p))))) f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

    rattrs :: VHDLM Doc
rattrs      = Text -> [(Identifier, Attr Text)] -> VHDLM Doc
renderAttrs (String -> Text
TextS.pack String
"signal") [(Identifier, Attr Text)]
attrs
    attrs :: [(Identifier, Attr Text)]
attrs       = [(Identifier, Attr Text)]
inputAttrs [(Identifier, Attr Text)]
-> [(Identifier, Attr Text)] -> [(Identifier, Attr Text)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr Text)]
outputAttrs
    inputAttrs :: [(Identifier, Attr Text)]
inputAttrs  = [(Identifier
id_, Attr Text
attr) | (Identifier
id_, HWType
hwtype) <- Component -> [(Identifier, HWType)]
inputs Component
c, Attr Text
attr <- HWType -> [Attr Text]
hwTypeAttrs HWType
hwtype]
    outputAttrs :: [(Identifier, Attr Text)]
outputAttrs = [(Identifier
id_, Attr Text
attr) | (Usage
_, (Identifier
id_, HWType
hwtype), Maybe Expr
_) <- Component -> [(Usage, (Identifier, HWType), Maybe Expr)]
outputs Component
c, Attr Text
attr <- HWType -> [Attr Text]
hwTypeAttrs HWType
hwtype]


architecture :: Component -> VHDLM Doc
architecture :: Component -> VHDLM Doc
architecture Component
c = do {
  ; HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  ; let attrs :: [(Identifier, Attr Text)]
attrs = case HdlSyn
syn of
                  -- See: [Note] Hack entity attributes in architecture
                  HdlSyn
Other -> [(Identifier, Attr Text)]
declAttrs
                  HdlSyn
_     -> [(Identifier, Attr Text)]
inputAttrs [(Identifier, Attr Text)]
-> [(Identifier, Attr Text)] -> [(Identifier, Attr Text)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr Text)]
outputAttrs [(Identifier, Attr Text)]
-> [(Identifier, Attr Text)] -> [(Identifier, Attr Text)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr Text)]
declAttrs
  ; Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
      ((VHDLM Doc
"architecture structural of" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
       [Declaration] -> VHDLM Doc
decls (Component -> [Declaration]
declarations Component
c)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
       if [(Identifier, Attr Text)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr Text)]
attrs then VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Text -> [(Identifier, Attr Text)] -> VHDLM Doc
renderAttrs (String -> Text
TextS.pack String
"signal") [(Identifier, Attr Text)]
attrs) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
      (VHDLM Doc
"begin" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
       [Declaration] -> VHDLM Doc
insts (Component -> [Declaration]
declarations Component
c)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc
"end" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  }
 where
   netdecls :: [Declaration]
netdecls    = (Declaration -> Bool) -> [Declaration] -> [Declaration]
forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isNetDecl (Component -> [Declaration]
declarations Component
c)
   declAttrs :: [(Identifier, Attr Text)]
declAttrs   = [(Identifier
id_, Attr Text
attr) | NetDecl' Maybe Text
_ Identifier
id_ HWType
hwtype Maybe Expr
_ <- [Declaration]
netdecls, Attr Text
attr <- HWType -> [Attr Text]
hwTypeAttrs HWType
hwtype]
   inputAttrs :: [(Identifier, Attr Text)]
inputAttrs  = [(Identifier
id_, Attr Text
attr) | (Identifier
id_, HWType
hwtype) <- Component -> [(Identifier, HWType)]
inputs Component
c, Attr Text
attr <- HWType -> [Attr Text]
hwTypeAttrs HWType
hwtype]
   outputAttrs :: [(Identifier, Attr Text)]
outputAttrs = [(Identifier
id_, Attr Text
attr) | (Usage
_, (Identifier
id_, HWType
hwtype), Maybe Expr
_) <- Component -> [(Usage, (Identifier, HWType), Maybe Expr)]
outputs Component
c, Attr Text
attr <- HWType -> [Attr Text]
hwTypeAttrs HWType
hwtype]

   isNetDecl :: Declaration -> Bool
   isNetDecl :: Declaration -> Bool
isNetDecl NetDecl'{} = Bool
True
   isNetDecl Declaration
_          = Bool
False

attrType ::
  HashMap TextS.Text TextS.Text ->
  Attr TextS.Text ->
  HashMap TextS.Text TextS.Text
attrType :: HashMap Text Text -> Attr Text -> HashMap Text Text
attrType HashMap Text Text
types Attr Text
attr =
  case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name' HashMap Text Text
types of
    Maybe Text
Nothing    -> Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
name' Text
type' HashMap Text Text
types
    Just Text
type'' | Text
type'' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
type' -> HashMap Text Text
types
                | Bool
otherwise -> String -> HashMap Text Text
forall a. HasCallStack => String -> a
error (String -> HashMap Text Text) -> String -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$
                      $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ Text -> String
TextS.unpack Text
name', String
"already assigned"
                                           , Text -> String
TextS.unpack Text
type'', String
"while we tried to"
                                           , String
"add", Text -> String
TextS.unpack Text
type' ]
 where
  name' :: Text
name' = Attr Text -> Text
forall a. Attr a -> a
attrName Attr Text
attr
  type' :: Text
type' = case Attr Text
attr of
            BoolAttr Text
_ Bool
_    -> Text
"boolean"
            IntegerAttr Text
_ Integer
_ -> Text
"integer"
            StringAttr Text
_ Text
_  -> Text
"string"
            Attr Text
_          -> Text
"boolean"

attrName :: Attr a -> a
attrName :: forall a. Attr a -> a
attrName = \case
  BoolAttr a
a Bool
_ -> a
a
  IntegerAttr a
a Integer
_ -> a
a
  StringAttr a
a a
_ -> a
a
  Attr a
a -> a
a

-- | Create 'attrname -> type' mapping for given attributes. Will err if multiple
-- types are assigned to the same name.
attrTypes :: [Attr TextS.Text] -> HashMap TextS.Text TextS.Text
attrTypes :: [Attr Text] -> HashMap Text Text
attrTypes = (HashMap Text Text -> Attr Text -> HashMap Text Text)
-> HashMap Text Text -> [Attr Text] -> HashMap 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 HashMap Text Text -> Attr Text -> HashMap Text Text
attrType HashMap Text Text
forall k v. HashMap k v
HashMap.empty

-- | Create a 'attrname -> (type, [(signalname, value)]). Will err if multiple
-- types are assigned to the same name.
attrMap
  :: forall t
   . t ~ HashMap TextS.Text (TextS.Text, [(TextS.Text, TextS.Text)])
  => [(Identifier, Attr TextS.Text)]
  -> t
attrMap :: forall t.
(t ~ HashMap Text (Text, [(Text, Text)])) =>
[(Identifier, Attr Text)] -> t
attrMap [(Identifier, Attr Text)]
attrs0 = (t -> (Text, Attr Text) -> t) -> t -> [(Text, Attr Text)] -> t
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 t -> (Text, Attr Text) -> t
go t
HashMap Text (Text, [(Text, Text)])
empty' [(Text, Attr Text)]
attrs1
 where
  attrs1 :: [(Text, Attr Text)]
attrs1 = ((Identifier, Attr Text) -> (Text, Attr Text))
-> [(Identifier, Attr Text)] -> [(Text, Attr Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Text)
-> (Identifier, Attr Text) -> (Text, Attr Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Identifier -> Text
Id.toText) [(Identifier, Attr Text)]
attrs0

  empty' :: HashMap Text (Text, [(Text, Text)])
empty' = [(Text, (Text, [(Text, Text)]))]
-> HashMap Text (Text, [(Text, Text)])
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
           [(Text
k, (HashMap Text Text
types HashMap Text Text -> Text -> Text
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! Text
k, [])) | Text
k <- HashMap Text Text -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Text
types]
  types :: HashMap Text Text
types = [Attr Text] -> HashMap Text Text
attrTypes (((Text, Attr Text) -> Attr Text)
-> [(Text, Attr Text)] -> [Attr Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Attr Text) -> Attr Text
forall a b. (a, b) -> b
snd [(Text, Attr Text)]
attrs1)

  go :: t -> (TextS.Text, Attr TextS.Text) -> t
  go :: t -> (Text, Attr Text) -> t
go t
map' (Text, Attr Text)
attr = ((Text, [(Text, Text)]) -> (Text, [(Text, Text)]))
-> Text
-> HashMap Text (Text, [(Text, Text)])
-> HashMap Text (Text, [(Text, Text)])
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust ((Text, Attr Text)
-> (Text, [(Text, Text)]) -> (Text, [(Text, Text)])
go' (Text, Attr Text)
attr) (Attr Text -> Text
forall a. Attr a -> a
attrName (Attr Text -> Text) -> Attr Text -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Attr Text) -> Attr Text
forall a b. (a, b) -> b
snd (Text, Attr Text)
attr) t
HashMap Text (Text, [(Text, Text)])
map'

  go'
    :: (TextS.Text, Attr TextS.Text)
    -> (TextS.Text, [(TextS.Text, TextS.Text)])
    -> (TextS.Text, [(TextS.Text, TextS.Text)])
  go' :: (Text, Attr Text)
-> (Text, [(Text, Text)]) -> (Text, [(Text, Text)])
go' (Text
signalName, Attr Text
attr) (Text
typ, [(Text, Text)]
elems) =
    (Text
typ, (Text
signalName, Attr Text -> Text
renderAttr Attr Text
attr) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
elems)

renderAttrs
  :: TextS.Text
  -> [(Identifier, Attr TextS.Text)]
  -> VHDLM Doc
renderAttrs :: Text -> [(Identifier, Attr Text)] -> VHDLM Doc
renderAttrs Text
what ([(Identifier, Attr Text)] -> HashMap Text (Text, [(Text, Text)])
forall t.
(t ~ HashMap Text (Text, [(Text, Text)])) =>
[(Identifier, Attr Text)] -> t
attrMap -> HashMap Text (Text, [(Text, Text)])
attrs) =
  Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence ([VHDLM Doc] -> Ap (State VHDLState) [Doc])
-> [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ VHDLM Doc -> [VHDLM Doc] -> [VHDLM Doc]
forall a. a -> [a] -> [a]
intersperse VHDLM Doc
" " ([VHDLM Doc] -> [VHDLM Doc]) -> [VHDLM Doc] -> [VHDLM Doc]
forall a b. (a -> b) -> a -> b
$ ((Text, (Text, [(Text, Text)])) -> VHDLM Doc)
-> [(Text, (Text, [(Text, Text)]))] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, [(Text, Text)])) -> VHDLM Doc
renderAttrGroup (HashMap Text (Text, [(Text, Text)])
-> [(Text, (Text, [(Text, Text)]))]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text (Text, [(Text, Text)])
attrs)
 where
  renderAttrGroup
    :: (TextS.Text, (TextS.Text, [(TextS.Text, TextS.Text)]))
    -> VHDLM Doc
  renderAttrGroup :: (Text, (Text, [(Text, Text)])) -> VHDLM Doc
renderAttrGroup (Text
attrname, (Text
typ, [(Text, Text)]
elems)) =
    (VHDLM Doc
"attribute" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
attrname VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
typ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence ([VHDLM Doc] -> Ap (State VHDLState) [Doc])
-> [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> VHDLM Doc) -> [(Text, Text)] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> (Text, Text) -> VHDLM Doc
renderAttrDecl Text
attrname) [(Text, Text)]
elems)

  renderAttrDecl
    :: TextS.Text
    -> (TextS.Text, TextS.Text)
    -> VHDLM Doc
  renderAttrDecl :: Text -> (Text, Text) -> VHDLM Doc
renderAttrDecl Text
attrname (Text
signalName, Text
value) =
        VHDLM Doc
"attribute"
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
attrname
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"of"
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
signalName -- or component name
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
what VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"is" -- "signal is" or "component is"
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
value
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

-- | Convert single attribute to VHDL syntax
renderAttr :: Attr TextS.Text -> TextS.Text
renderAttr :: Attr Text -> Text
renderAttr (StringAttr  Text
_key Text
value) = Char -> Text -> Text
wrap Char
'"' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
TextS.replace Text
"\"" Text
"\"\"" Text
value
renderAttr (IntegerAttr Text
_key Integer
value) = String -> Text
TextS.pack (Integer -> String
forall a. Show a => a -> String
show Integer
value)
renderAttr (BoolAttr    Text
_key Bool
True ) = Text
"true"
renderAttr (BoolAttr    Text
_key Bool
False) = Text
"false"
renderAttr (Attr        Text
_key      ) = Text
"true"

-- | Prepend and append a character to a string
wrap :: Char -> TextS.Text -> TextS.Text
wrap :: Char -> Text -> Text
wrap Char
c = Char -> Text -> Text
forall s a. Cons s s a a => a -> s -> s
cons Char
c (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text
forall s a. Snoc s s a a => s -> a -> s
`snoc` Char
c)

sigDecl :: VHDLM Doc -> HWType -> VHDLM Doc
sigDecl :: VHDLM Doc -> HWType -> VHDLM Doc
sigDecl VHDLM Doc
d HWType
t = VHDLM Doc
d VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
t

-- | Append size information to given type string
appendSize :: VHDLM Doc -> HWType -> VHDLM Doc
appendSize :: VHDLM Doc -> HWType -> VHDLM Doc
appendSize VHDLM Doc
baseType HWType
sizedType = case HWType
sizedType of
  BitVector Int
n -> VHDLM Doc
baseType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto 0")
  Signed Int
n    -> VHDLM Doc
baseType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto 0")
  Unsigned Int
n  -> VHDLM Doc
baseType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto 0")
  Vector Int
n HWType
_  -> VHDLM Doc
baseType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"0 to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
  RTree Int
d HWType
_   -> VHDLM Doc
baseType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"0 to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ((Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
  MemBlob Int
n Int
_ -> VHDLM Doc
baseType VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"0 to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
  Annotated [Attr Text]
_ HWType
elTy -> VHDLM Doc -> HWType -> VHDLM Doc
appendSize VHDLM Doc
baseType HWType
elTy
  HWType
_           -> VHDLM Doc
baseType

-- | Same as @qualTyName@, but instantiate generic types with their size.
sizedQualTyName :: HWType -> VHDLM Doc
sizedQualTyName :: HWType -> VHDLM Doc
sizedQualTyName (HWType -> HWType
filterTransparent -> HWType
hwty) = VHDLM Doc -> HWType -> VHDLM Doc
appendSize (HWType -> VHDLM Doc
qualTyName HWType
hwty) HWType
hwty

-- | Same as @tyName@, but instantiate generic types with their size.
sizedTyName :: HWType -> VHDLM Doc
sizedTyName :: HWType -> VHDLM Doc
sizedTyName (HWType -> HWType
filterTransparent -> HWType
hwty) = VHDLM Doc -> HWType -> VHDLM Doc
appendSize (HWType -> VHDLM Doc
tyName HWType
hwty) HWType
hwty

-- | Same as @tyName@, but return fully qualified name (name, including module)
qualTyName :: HWType -> VHDLM Doc
qualTyName :: HWType -> VHDLM Doc
qualTyName (HWType -> HWType
filterTransparent -> HWType
hwty) = case HWType
hwty of
  -- Builtin types:
  HWType
Bit -> HWType -> VHDLM Doc
tyName HWType
hwty
  HWType
Bool -> HWType -> VHDLM Doc
tyName HWType
hwty
  Signed Int
_ -> HWType -> VHDLM Doc
tyName HWType
hwty
  Unsigned Int
_ -> HWType -> VHDLM Doc
tyName HWType
hwty
  BitVector Int
_ -> HWType -> VHDLM Doc
tyName HWType
hwty

  -- Transparent types:
  BiDirectional PortDirection
_ HWType
elTy -> HWType -> VHDLM Doc
qualTyName HWType
elTy
  Annotated [Attr Text]
_ HWType
elTy -> HWType -> VHDLM Doc
qualTyName HWType
elTy

  -- Custom types:
  HWType
_ -> do
    Bool
pkgCtx <- State VHDLState Bool -> Ap (State VHDLState) Bool
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Bool VHDLState Bool -> State VHDLState Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool VHDLState Bool
Lens' VHDLState Bool
tyPkgCtx)
    Text
modName <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm)

    if Bool
pkgCtx
      then HWType -> VHDLM Doc
tyName HWType
hwty
      else Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
modName VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types." VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> VHDLM Doc
tyName HWType
hwty

-- | Generates a unique name for a given type. This action will cache its
-- results, thus returning the same answer for the same @HWType@ argument.
-- Some type names do not have specific names, but are instead basic types
-- in VHDL.
tyName
  :: HWType
  -- ^ Type to name
  -> VHDLM Doc
tyName :: HWType -> VHDLM Doc
tyName HWType
t = do
  Text
nm <- HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
False HWType
t
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm

-- | Generates a unique name for a given type. This action will cache its
-- results, thus returning the same answer for the same @HWType@ argument.
-- Some type names do not have specific names, but are instead basic types
-- in VHDL.
tyName'
  :: HasCallStack
  => Bool
  -- ^ Include length information in first part of name. For example, say we
  -- want to generate a name for a vector<signed>, where the vector is of length
  -- 5, and signed has 64 bits. When given `True`, this function would
  -- generate `array_of_5_signed_64`. When given `False` it would generate
  -- `array_of_signed_64`. Note that parts other than the first part will always
  -- have length information. This option is useful for generating names in
  -- VHDL, where the `False` case is needed to create generic types.
  -> HWType
  -- ^ Type to name
  -> VHDLM TextS.Text
tyName' :: HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
rec0 (HWType -> HWType
filterTransparent -> HWType
t) = do
  State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> VHDLState -> Identity VHDLState)
-> (HashSet HWType -> HashSet HWType) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HWType -> HashSet HWType -> HashSet HWType
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert HWType
t)
  case HWType
t of
    KnownDomain {} ->
      Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Forced to print KnownDomain tyName"))
    Void Maybe HWType
_ ->
      Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Forced to print Void tyName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
t))
    HWType
Bool          -> Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"boolean"
    Signed Int
n      ->
      let app :: [Text]
app = if Bool
rec0 then [Text
"_", Int -> Text
forall a. Show a => a -> Text
showt Int
n] else [] in
      Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Ap (State VHDLState) Text)
-> Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
TextS.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"signed" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
app
    Unsigned Int
n    ->
      let app :: [Text]
app = if Bool
rec0 then [Text
"_", Int -> Text
forall a. Show a => a -> Text
showt Int
n] else [] in
      Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Ap (State VHDLState) Text)
-> Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
TextS.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"unsigned" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
app
    BitVector Int
n   ->
      let app :: [Text]
app = if Bool
rec0 then [Text
"_", Int -> Text
forall a. Show a => a -> Text
showt Int
n] else [] in
      Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Ap (State VHDLState) Text)
-> Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
TextS.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"std_logic_vector" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
app
    HWType
String        -> Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"string"
    HWType
Integer       -> Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"integer"
    HWType
Bit           -> Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"std_logic"
    Vector Int
n HWType
elTy -> do
      Text
elTy' <- HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
True HWType
elTy
      let nm :: Text
nm = [Text] -> Text
TextS.concat [ Text
"array_of_"
                            , if Bool
rec0 then Int -> Text
forall a. Show a => a -> Text
showt Int
n Text -> Text -> Text
`TextS.append` Text
"_" else Text
""
                            , Text
elTy']
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
rec0) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> State VHDLState Text
forall a. a -> StateT VHDLState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
nm)
    RTree Int
n HWType
elTy  -> do
      Text
elTy' <- HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
True HWType
elTy
      let nm :: Text
nm = [Text] -> Text
TextS.concat [ Text
"tree_of_"
                            , if Bool
rec0 then Int -> Text
forall a. Show a => a -> Text
showt Int
n Text -> Text -> Text
`TextS.append` Text
"_" else Text
""
                            , Text
elTy']
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
rec0) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> State VHDLState Text
forall a. a -> StateT VHDLState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
nm)
    -- TODO: nice formatting for Index. I.e., 2000 = 2e3, 1024 = 2pow10
    Index Integer
n ->
      Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text
"index_" Text -> Text -> Text
`TextS.append` Integer -> Text
forall a. Show a => a -> Text
showt Integer
n)
    Clock Text
nm0 ->
      let nm1 :: Text
nm1 = Text
"clk_" Text -> Text -> Text
`TextS.append` Text
nm0 in
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"clk" Text
nm1 HWType
t)
    ClockN Text
nm0 ->
      let nm1 :: Text
nm1 = Text
"clk_n_" Text -> Text -> Text
`TextS.append` Text
nm0 in
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"clk" Text
nm1 HWType
t)
    Reset Text
nm0 ->
      let nm1 :: Text
nm1 = Text
"rst_" Text -> Text -> Text
`TextS.append` Text
nm0 in
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"rst" Text
nm1 HWType
t)
    Enable Text
nm0 ->
      let nm1 :: Text
nm1 = Text
"en_" Text -> Text -> Text
`TextS.append` Text
nm0 in
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"en" Text
nm1 HWType
t)
    Sum Text
nm [Text]
_  ->
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"sum" Text
nm HWType
t)
    CustomSum Text
nm DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_ ->
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"sum" Text
nm HWType
t)
    SP Text
nm [(Text, [HWType])]
_ ->
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"sp" Text
nm HWType
t)
    CustomSP Text
nm DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_ ->
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"sp" Text
nm HWType
t)
    Product Text
nm Maybe [Text]
_ [HWType]
_ ->
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"product" Text
nm HWType
t)
    CustomProduct Text
nm DataRepr'
_ Int
_ Maybe [Text]
_ [(Integer, HWType)]
_ ->
      State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Text)
-> State VHDLState Text
-> State VHDLState Text
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) (HashMap (HWType, Bool) Text -> f (HashMap (HWType, Bool) Text))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"product" Text
nm HWType
t)
    Annotated [Attr Text]
_ HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
rec0 HWType
hwTy
    BiDirectional PortDirection
_ HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Ap (State VHDLState) Text
Bool -> HWType -> Ap (State VHDLState) Text
tyName' Bool
rec0 HWType
hwTy
    HWType
FileType -> Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"file"
    HWType
ty -> Text -> Ap (State VHDLState) Text
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++  HWType -> String
forall a. Show a => a -> String
show HWType
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String
" not filtered by filterTransparent"))

-- | Returns underlying type of given HWType. That is, the type by which it
-- eventually will be represented in VHDL.
normaliseType :: RenderEnums -> HWType -> HWType
normaliseType :: RenderEnums -> HWType -> HWType
normaliseType enums :: RenderEnums
enums@(RenderEnums Bool
e) HWType
hwty = case HWType
hwty of
  Void {} -> HWType
hwty
  KnownDomain {} -> HWType
hwty

  -- Base types:
  HWType
Bool          -> HWType
hwty
  Signed Int
_      -> HWType
hwty
  Unsigned Int
_    -> HWType
hwty
  BitVector Int
_   -> HWType
hwty
  HWType
String        -> HWType
hwty
  HWType
Integer       -> HWType
hwty
  HWType
Bit           -> HWType
hwty
  HWType
FileType      -> HWType
hwty

  -- Complex types, for which a user defined type is made in VHDL:
  Vector Int
_ HWType
_    -> HWType
hwty
  RTree Int
_ HWType
_     -> HWType
hwty
  Product Text
_ Maybe [Text]
_ [HWType]
_ -> HWType
hwty
  Sum Text
_ [Text]
_       -> if Bool
e then HWType
hwty else Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  MemBlob Int
n Int
m   -> Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m)

  -- Simple types, for which a subtype (without qualifiers) will be made in VHDL:
  Clock Text
_           -> HWType
Bit
  ClockN Text
_          -> HWType
Bit
  Reset Text
_           -> HWType
Bit
  Enable Text
_          -> HWType
Bool
  Index Integer
_           -> Int -> HWType
Unsigned (HWType -> Int
typeSize HWType
hwty)
  CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_  -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  SP Text
_ [(Text, [HWType])]
_            -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_ -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  CustomProduct {}  -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)

  -- Transparent types:
  Annotated [Attr Text]
_ HWType
elTy -> RenderEnums -> HWType -> HWType
normaliseType RenderEnums
enums HWType
elTy
  BiDirectional PortDirection
_ HWType
elTy -> RenderEnums -> HWType -> HWType
normaliseType RenderEnums
enums HWType
elTy

-- | Recursively remove transparent types from given type
filterTransparent :: HWType -> HWType
filterTransparent :: HWType -> HWType
filterTransparent HWType
hwty = case HWType
hwty of
  HWType
Bool              -> HWType
hwty
  Signed Int
_          -> HWType
hwty
  Unsigned Int
_        -> HWType
hwty
  BitVector Int
_       -> HWType
hwty
  HWType
String            -> HWType
hwty
  HWType
Integer           -> HWType
hwty
  HWType
Bit               -> HWType
hwty
  Clock Text
_           -> HWType
hwty
  ClockN Text
_          -> HWType
hwty
  Reset Text
_           -> HWType
hwty
  Enable Text
_          -> HWType
hwty
  Index Integer
_           -> HWType
hwty
  Sum Text
_ [Text]
_           -> HWType
hwty
  CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_ -> HWType
hwty
  HWType
FileType          -> HWType
hwty

  MemBlob Int
n Int
m       -> Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m)

  Vector Int
n HWType
elTy     -> Int -> HWType -> HWType
Vector Int
n (HWType -> HWType
filterTransparent HWType
elTy)
  RTree Int
n HWType
elTy      -> Int -> HWType -> HWType
RTree Int
n (HWType -> HWType
filterTransparent HWType
elTy)
  Product Text
nm Maybe [Text]
labels [HWType]
elTys  ->
    Text -> Maybe [Text] -> [HWType] -> HWType
Product Text
nm Maybe [Text]
labels ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
elTys)

  SP Text
nm0 [(Text, [HWType])]
constrs ->
    Text -> [(Text, [HWType])] -> HWType
SP Text
nm0
      (((Text, [HWType]) -> (Text, [HWType]))
-> [(Text, [HWType])] -> [(Text, [HWType])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
nm1, [HWType]
tys) -> (Text
nm1, (HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
tys)) [(Text, [HWType])]
constrs)

  CustomSP Text
nm0 DataRepr'
drepr Int
size [(ConstrRepr', Text, [HWType])]
constrs ->
    Text
-> DataRepr' -> Int -> [(ConstrRepr', Text, [HWType])] -> HWType
CustomSP Text
nm0 DataRepr'
drepr Int
size
      (((ConstrRepr', Text, [HWType]) -> (ConstrRepr', Text, [HWType]))
-> [(ConstrRepr', Text, [HWType])]
-> [(ConstrRepr', Text, [HWType])]
forall a b. (a -> b) -> [a] -> [b]
map (\(ConstrRepr'
repr, Text
nm1, [HWType]
tys) -> (ConstrRepr'
repr, Text
nm1, (HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
tys)) [(ConstrRepr', Text, [HWType])]
constrs)

  CustomProduct Text
nm0 DataRepr'
drepr Int
size Maybe [Text]
maybeFieldNames [(Integer, HWType)]
constrs ->
    Text
-> DataRepr'
-> Int
-> Maybe [Text]
-> [(Integer, HWType)]
-> HWType
CustomProduct Text
nm0 DataRepr'
drepr Int
size Maybe [Text]
maybeFieldNames
      (((Integer, HWType) -> (Integer, HWType))
-> [(Integer, HWType)] -> [(Integer, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map ((HWType -> HWType) -> (Integer, HWType) -> (Integer, HWType)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second HWType -> HWType
filterTransparent) [(Integer, HWType)]
constrs)

  -- Transparent types:
  Annotated [Attr Text]
_ HWType
elTy -> HWType -> HWType
filterTransparent HWType
elTy
  BiDirectional PortDirection
_ HWType
elTy -> HWType -> HWType
filterTransparent HWType
elTy

  Void {} -> HWType
hwty
  KnownDomain {} -> HWType
hwty

-- | Create a unique type name for user defined types
userTyName
  :: IdentifierText
  -- ^ Default name
  -> IdentifierText
  -- ^ Identifier stored in @hwTy@
  -> HWType
  -- ^ Type to give a (unique) name
  -> StateT VHDLState Identity IdentifierText
userTyName :: Text -> Text -> HWType -> State VHDLState Text
userTyName Text
dflt Text
nm0 HWType
hwTy = do
  (HashSet HWType -> Identity (HashSet HWType))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> VHDLState -> Identity VHDLState)
-> (HashSet HWType -> HashSet HWType) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HWType -> HashSet HWType -> HashSet HWType
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert HWType
hwTy
  Identifier -> Text
Id.toText (Identifier -> Text)
-> State VHDLState Identifier -> State VHDLState Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> State VHDLState Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> Text -> m Identifier
Id.makeBasicOr ([Text] -> Text
forall a. HasCallStack => [a] -> a
last (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
TextS.splitOn Text
"." Text
nm0)) Text
dflt

-- | Convert a Netlist HWType to an error VHDL value for that type
sizedQualTyNameErrValue :: HWType -> VHDLM Doc
sizedQualTyNameErrValue :: HWType -> VHDLM Doc
sizedQualTyNameErrValue HWType
Bool                = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Ap (State VHDLState) (Maybe (Maybe Int))
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Just (Just Int
0) -> VHDLM Doc
"false"
    Maybe (Maybe Int)
_             -> VHDLM Doc
"true"
sizedQualTyNameErrValue HWType
Bit                 = VHDLM Doc
singularErrValue
sizedQualTyNameErrValue t :: HWType
t@(Vector Int
n HWType
elTy)   = do
  HdlSyn
syn <-State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                 VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
singularErrValue))
    HdlSyn
_ -> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(RTree Int
n HWType
elTy)    = do
  HdlSyn
syn <-State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>  VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                 VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
singularErrValue))
    HdlSyn
_ -> HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>  VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(Product Text
_ Maybe [Text]
_ [HWType]
elTys) =
  HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((HWType -> VHDLM Doc) -> [HWType] -> Ap (State VHDLState) [Doc]
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 HWType -> VHDLM Doc
sizedQualTyNameErrValue [HWType]
elTys)
sizedQualTyNameErrValue t :: HWType
t@(Sum Text
_ [Text]
_)  = do
  -- No undefined / don't care for enums, so just set it to the first value
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  if Bool
enums then
    HWType -> VHDLM Doc
tyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'val" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
  else
    HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
singularErrValue)
sizedQualTyNameErrValue (Clock Text
_)  = VHDLM Doc
singularErrValue
sizedQualTyNameErrValue (ClockN Text
_) = VHDLM Doc
singularErrValue
sizedQualTyNameErrValue (Reset Text
_)  = VHDLM Doc
singularErrValue
sizedQualTyNameErrValue (Enable Text
_) = VHDLM Doc
singularErrValue
sizedQualTyNameErrValue (Void {})  =
  Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Doc
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[CLASH BUG] Forced to print Void error value"))
sizedQualTyNameErrValue HWType
String              = VHDLM Doc
"\"ERROR\""
sizedQualTyNameErrValue HWType
t =
  HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
singularErrValue)

singularErrValue :: VHDLM Doc
singularErrValue :: VHDLM Doc
singularErrValue = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Ap (State VHDLState) (Maybe (Maybe Int))
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Maybe (Maybe Int)
Nothing       -> VHDLM Doc
"'-'"
    Just Maybe Int
Nothing  -> VHDLM Doc
"'0'"
    Just (Just Int
x) -> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'"

vhdlRecSel
  :: HWType
  -> Int
  -> VHDLM Doc
vhdlRecSel :: HWType -> Int -> VHDLM Doc
vhdlRecSel p :: HWType
p@(Product Text
_ Maybe [Text]
labels [HWType]
tys) Int
i =
  HWType -> VHDLM Doc
tyName HWType
p VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
i
vhdlRecSel HWType
ty Int
i =
  HWType -> VHDLM Doc
tyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_sel" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i

decls :: [Declaration] -> VHDLM Doc
decls :: [Declaration] -> VHDLM Doc
decls [] = VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
decls [Declaration]
ds = do
    rec ([Doc]
dsDoc,[Int]
ls) <- ([Maybe (Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [Maybe (Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Doc, Int)] -> ([Doc], [Int]))
-> ([Maybe (Doc, Int)] -> [(Doc, Int)])
-> [Maybe (Doc, Int)]
-> ([Doc], [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Doc, Int)] -> [(Doc, Int)]
forall a. [Maybe a] -> [a]
catMaybes) (Ap (State VHDLState) [Maybe (Doc, Int)]
 -> Ap (State VHDLState) ([Doc], [Int]))
-> Ap (State VHDLState) [Maybe (Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ (Declaration -> Ap (State VHDLState) (Maybe (Doc, Int)))
-> [Declaration] -> Ap (State VHDLState) [Maybe (Doc, Int)]
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 (Int -> Declaration -> Ap (State VHDLState) (Maybe (Doc, Int))
decl ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls)) [Declaration]
ds
    case [Doc]
dsDoc of
      [] -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      [Doc]
_  -> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
dsDoc)

decl :: Int ->  Declaration -> VHDLM (Maybe (Doc,Int))
decl :: Int -> Declaration -> Ap (State VHDLState) (Maybe (Doc, Int))
decl Int
l (NetDecl' Maybe Text
noteM Identifier
id_ HWType
ty Maybe Expr
iEM) = (Doc, Int) -> Maybe (Doc, Int)
forall a. a -> Maybe a
Just ((Doc, Int) -> Maybe (Doc, Int))
-> (Doc -> (Doc, Int)) -> Doc -> Maybe (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (,Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
TextS.length (Identifier -> Text
Id.toText Identifier
id_))) (Doc -> Maybe (Doc, Int))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (VHDLM Doc -> VHDLM Doc)
-> (Text -> VHDLM Doc -> VHDLM Doc)
-> Maybe Text
-> VHDLM Doc
-> VHDLM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VHDLM Doc -> VHDLM Doc
forall a. a -> a
id Text -> VHDLM Doc -> VHDLM Doc
forall {f :: Type -> Type} {a}.
(Monoid (f Doc), Applicative f, IsString (f Doc), Pretty a) =>
a -> f Doc -> f Doc
addNote Maybe Text
noteM (VHDLM Doc
"signal" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill Int
l (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
iE VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
  where
    addNote :: a -> f Doc -> f Doc
addNote a
n = f Doc -> f Doc -> f Doc
forall a. Monoid a => a -> a -> a
mappend (f Doc
"--" f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> a -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty a
n f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
line)
    iE :: VHDLM Doc
iE = VHDLM Doc -> (Expr -> VHDLM Doc) -> Maybe Expr -> VHDLM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (VHDLM Doc -> VHDLM Doc
noEmptyInit (VHDLM Doc -> VHDLM Doc)
-> (Expr -> VHDLM Doc) -> Expr -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False) Maybe Expr
iEM

decl Int
_ (InstDecl EntityOrComponent
Comp Maybe Text
_ [Attr Text]
attrs Identifier
nm Identifier
_ [(Expr, HWType, Expr)]
gens (NamedPortMap [(Expr, PortDirection, HWType, Expr)]
pms)) = (Doc -> Maybe (Doc, Int))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int))
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc, Int) -> Maybe (Doc, Int)
forall a. a -> Maybe a
Just ((Doc, Int) -> Maybe (Doc, Int))
-> (Doc -> (Doc, Int)) -> Doc -> Maybe (Doc, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Int
0)) (VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int)))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int))
forall a b. (a -> b) -> a -> b
$ do
  { rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Ap (State VHDLState) [(Doc, Int)]
 -> Ap (State VHDLState) ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ (,Expr -> Int
forall {b}. Num b => Expr -> b
formalLength Expr
i) (Doc -> (Doc, Int)) -> VHDLM Doc -> Ap (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
i) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> PortDirection -> VHDLM Doc
forall {a}. IsString a => PortDirection -> a
portDir PortDirection
dir VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
ty | (Expr
i,PortDirection
dir,HWType
ty,Expr
_) <- [(Expr, PortDirection, HWType, Expr)]
pms ]
  ; rec ([Doc]
g,[Int]
lsg) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Ap (State VHDLState) [(Doc, Int)]
 -> Ap (State VHDLState) ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ (,Expr -> Int
forall {b}. Num b => Expr -> b
formalLength Expr
i) (Doc -> (Doc, Int)) -> VHDLM Doc -> Ap (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
lsg) (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
i) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
tyName HWType
ty | (Expr
i,HWType
ty,Expr
_) <- [(Expr, HWType, Expr)]
gens]
  ; VHDLM Doc
"component" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    ( if [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
g then VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
        else Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"generic" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f [Doc] -> f Doc
tupledSemi ([Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
g) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
    )
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (VHDLM Doc
"port" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f [Doc] -> f Doc
tupledSemi ([Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
    VHDLM Doc
"end component" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
attrs'
  }
 where
    formalLength :: Expr -> b
formalLength (Identifier Identifier
i Maybe Modifier
_) = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
TextS.length (Identifier -> Text
Id.toText Identifier
i))
    formalLength Expr
_                = b
0

    portDir :: PortDirection -> a
portDir PortDirection
In  = a
"in"
    portDir PortDirection
Out = a
"out"

    attrs' :: VHDLM Doc
attrs'
      | [Attr Text] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Attr Text]
attrs = VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      | Bool
otherwise = Text -> [(Identifier, Attr Text)] -> VHDLM Doc
renderAttrs (String -> Text
TextS.pack String
"component") [(Identifier
nm, Attr Text
a) | Attr Text
a <- [Attr Text]
attrs]

decl Int
_ (CompDecl Text
nm [(Text, PortDirection, HWType)]
ps0) =
  (Doc -> Maybe (Doc, Int))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int))
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc, Int) -> Maybe (Doc, Int)
forall a. a -> Maybe a
Just ((Doc, Int) -> Maybe (Doc, Int))
-> (Doc -> (Doc, Int)) -> Doc -> Maybe (Doc, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Int
0)) (VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int)))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe (Doc, Int))
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
"component" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
    (VHDLM Doc
"port" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f [Doc] -> f Doc
tupledSemi Ap (State VHDLState) [Doc]
ps VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi))
    VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"end component" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  where ps :: Ap (State VHDLState) [Doc]
ps = ((Text, PortDirection, HWType) -> VHDLM Doc)
-> [(Text, PortDirection, HWType)] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Text
t,PortDirection
pd,HWType
ty) -> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
":" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> PortDirection -> VHDLM Doc
ppd PortDirection
pd VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> VHDLM Doc
sizedQualTyName HWType
ty) [(Text, PortDirection, HWType)]
ps0
        ppd :: PortDirection -> VHDLM Doc
ppd = \case { PortDirection
In -> VHDLM Doc
"in"; PortDirection
Out -> VHDLM Doc
"out"}

decl Int
_ Declaration
_ = Maybe (Doc, Int) -> Ap (State VHDLState) (Maybe (Doc, Int))
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (Doc, Int)
forall a. Maybe a
Nothing

noEmptyInit :: VHDLM Doc -> VHDLM Doc
noEmptyInit :: VHDLM Doc -> VHDLM Doc
noEmptyInit VHDLM Doc
d = do
  Doc
d1 <- VHDLM Doc
d
  if Doc -> Bool
isEmpty Doc
d1
     then VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
     else (VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
space VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
":=" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
d)

stdMatch
  :: Bits a
  => Int
  -> a
  -> a
  -> String
stdMatch :: forall a. Bits a => Int -> a -> a -> String
stdMatch Int
0 a
_mask a
_value = []
stdMatch Int
size a
mask a
value =
  Char
symbol Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> a -> a -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
mask a
value
  where
    symbol :: Char
symbol =
      if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
mask (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
        if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
value (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
          Char
'1'
        else
          Char
'0'
      else
        Char
'-'

patLitCustom'
  :: Bits a
  => VHDLM Doc
  -> Int
  -> a
  -> a
  -> VHDLM Doc
patLitCustom' :: forall a. Bits a => VHDLM Doc -> Int -> a -> a -> VHDLM Doc
patLitCustom' VHDLM Doc
var Int
size a
mask a
value =
  let mask' :: VHDLM Doc
mask' = Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> VHDLM Doc) -> Text -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch Int
size a
mask a
value in
  VHDLM Doc
"std_match" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes VHDLM Doc
mask' VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
var)

patLitCustom
  :: VHDLM Doc
  -> HWType
  -> Literal
  -> VHDLM Doc
patLitCustom :: VHDLM Doc -> HWType -> Literal -> VHDLM Doc
patLitCustom VHDLM Doc
var (CustomSum Text
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Text)]
reprs) (NumLit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i)) =
  VHDLM Doc -> Int -> Integer -> Integer -> VHDLM Doc
forall a. Bits a => VHDLM Doc -> Int -> a -> a -> VHDLM Doc
patLitCustom' VHDLM Doc
var Int
size Integer
mask Integer
value
    where
      ((ConstrRepr' Text
_name Int
_n Integer
mask Integer
value [Integer]
_anns), Text
_id) = [(ConstrRepr', Text)]
reprs [(ConstrRepr', Text)] -> Int -> (ConstrRepr', Text)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i

patLitCustom VHDLM Doc
var (CustomSP Text
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Text, [HWType])]
reprs) (NumLit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i)) =
  VHDLM Doc -> Int -> Integer -> Integer -> VHDLM Doc
forall a. Bits a => VHDLM Doc -> Int -> a -> a -> VHDLM Doc
patLitCustom' VHDLM Doc
var Int
size Integer
mask Integer
value
    where
      ((ConstrRepr' Text
_name Int
_n Integer
mask Integer
value [Integer]
_anns), Text
_id, [HWType]
_tys) = [(ConstrRepr', Text, [HWType])]
reprs [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
i

patLitCustom VHDLM Doc
_ HWType
x Literal
y = String -> VHDLM Doc
forall a. HasCallStack => String -> a
error (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
  [ String
"You can only pass CustomSP / CustomSum and a NumLit to this function,"
  , String
"not", HWType -> String
forall a. Show a => a -> String
show HWType
x, String
"and", Literal -> String
forall a. Show a => a -> String
show Literal
y]

insts :: [Declaration] -> VHDLM Doc
insts :: [Declaration] -> VHDLM Doc
insts [] = VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl (Comment Text
c):[Declaration]
ds) = Text -> Text -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Text -> Text -> f Doc
comment Text
"--" Text
c VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> VHDLM Doc
insts [Declaration]
ds
insts (TickDecl (Directive Text
d):[Declaration]
ds) = Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
d VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
";" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> VHDLM Doc
insts [Declaration]
ds
insts (Declaration
d:[Declaration]
ds) = do
  Maybe Doc
d' <- Declaration -> Ap (State VHDLState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
d' of
    Just Doc
doc -> Doc -> VHDLM Doc
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> VHDLM Doc
insts [Declaration]
ds
    Maybe Doc
_ -> [Declaration] -> VHDLM Doc
insts [Declaration]
ds

-- | Helper function for inst_, handling CustomSP and CustomSum
inst_'
  :: Identifier
  -> Expr
  -> HWType
  -> [(Maybe Literal, Expr)]
  -> VHDLM (Maybe Doc)
inst_' :: Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es = (Doc -> Maybe Doc) -> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VHDLM Doc -> Ap (State VHDLState) (Maybe Doc))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
larrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([(Maybe Literal, Expr)] -> Ap (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
esNub) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi))
    where
      esMod :: [(Maybe Literal, Expr)]
esMod = ((Maybe Literal, Expr) -> (Maybe Literal, Expr))
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Literal -> Maybe Literal)
-> (Maybe Literal, Expr) -> (Maybe Literal, Expr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HWType -> Literal -> Literal
patMod HWType
scrutTy))) [(Maybe Literal, Expr)]
es
      esNub :: [(Maybe Literal, Expr)]
esNub = ((Maybe Literal, Expr) -> (Maybe Literal, Expr) -> Bool)
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Maybe Literal -> Maybe Literal -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Literal -> Maybe Literal -> Bool)
-> ((Maybe Literal, Expr) -> Maybe Literal)
-> (Maybe Literal, Expr)
-> (Maybe Literal, Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Literal, Expr) -> Maybe Literal
forall a b. (a, b) -> a
fst) [(Maybe Literal, Expr)]
esMod
      var :: VHDLM Doc
var   = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
True Expr
scrut

      conds :: [(Maybe Literal,Expr)] -> VHDLM [Doc]
      conds :: [(Maybe Literal, Expr)] -> Ap (State VHDLState) [Doc]
conds []                = [Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
      conds [(Maybe Literal
_,Expr
e)]           = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
      conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_)   = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
      conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"when"
                                              VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> HWType -> Literal -> VHDLM Doc
patLitCustom VHDLM Doc
var HWType
scrutTy Literal
c
                                              VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"else"
                                              VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [(Maybe Literal, Expr)] -> Ap (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
es'

-- | Turn a Netlist Declaration to a VHDL concurrent block
inst_ :: Declaration -> VHDLM (Maybe Doc)
inst_ :: Declaration -> Ap (State VHDLState) (Maybe Doc)
inst_ (Assignment Identifier
id_ Usage
Cont Expr
e) = (Doc -> Maybe Doc) -> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VHDLM Doc -> Ap (State VHDLState) (Maybe Doc))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
larrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut HWType
_ [(Just (BoolLit Bool
b), Expr
l),(Maybe Literal
_,Expr
r)]) = (Doc -> Maybe Doc) -> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VHDLM Doc -> Ap (State VHDLState) (Maybe Doc))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
larrow
           VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vsep ([VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"when" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                                      HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
scrut VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"else"
                                     ,HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
f VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
                                     ]))
  where
    (Expr
t,Expr
f) = if Bool
b then (Expr
l,Expr
r) else (Expr
r,Expr
l)

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_) [(Maybe Literal, Expr)]
es) =
  Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_) [(Maybe Literal, Expr)]
es) =
  Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es

inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ [(Integer, HWType)]
_) [(Maybe Literal, Expr)]
es) =
  Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es

inst_ (CondAssignment Identifier
id_ HWType
_sig Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es) = (Doc -> Maybe Doc) -> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VHDLM Doc -> Ap (State VHDLState) (Maybe Doc))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
    VHDLM Doc
"with" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
True Expr
scrut) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"select" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
larrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma ([(Maybe Literal, Expr)] -> Ap (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
esNub)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi))
  where
    esMod :: [(Maybe Literal, Expr)]
esMod = ((Maybe Literal, Expr) -> (Maybe Literal, Expr))
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Literal -> Maybe Literal)
-> (Maybe Literal, Expr) -> (Maybe Literal, Expr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HWType -> Literal -> Literal
patMod HWType
scrutTy))) [(Maybe Literal, Expr)]
es
    esNub :: [(Maybe Literal, Expr)]
esNub = ((Maybe Literal, Expr) -> (Maybe Literal, Expr) -> Bool)
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Maybe Literal -> Maybe Literal -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Literal -> Maybe Literal -> Bool)
-> ((Maybe Literal, Expr) -> Maybe Literal)
-> (Maybe Literal, Expr)
-> (Maybe Literal, Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Literal, Expr) -> Maybe Literal
forall a b. (a, b) -> a
fst) [(Maybe Literal, Expr)]
esMod

    conds :: [(Maybe Literal,Expr)] -> VHDLM [Doc]
    conds :: [(Maybe Literal, Expr)] -> Ap (State VHDLState) [Doc]
conds []                = [Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds [(Maybe Literal
_,Expr
e)]           = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"when" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"others" VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_)   = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"when" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"others" VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"when" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Literal -> VHDLM Doc
patLit HWType
scrutTy Literal
c VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [(Maybe Literal, Expr)] -> Ap (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
es'

inst_ (InstDecl EntityOrComponent
entOrComp Maybe Text
libM [Attr Text]
_ Identifier
nm Identifier
lbl [(Expr, HWType, Expr)]
gens PortMap
pms0) = do
    Ap (State VHDLState) ()
-> (Text -> Ap (State VHDLState) ())
-> Maybe Text
-> Ap (State VHDLState) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Ap (State VHDLState) ()
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) (\Text
lib -> State VHDLState () -> Ap (State VHDLState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Text -> Text
T.fromStrict Text
lib:))) Maybe Text
libM
    (Doc -> Maybe Doc) -> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (VHDLM Doc -> Ap (State VHDLState) (Maybe Doc))
-> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
lbl VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
entOrComp'
                VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc -> (Text -> VHDLM Doc) -> Maybe Text -> VHDLM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc ((VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
".") (VHDLM Doc -> VHDLM Doc)
-> (Text -> VHDLM Doc) -> Text -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Text
libM VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
gms VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
pms2 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  where
    gms :: VHDLM Doc
gms | [] <- [(Expr, HWType, Expr)]
gens = VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
        | Bool
otherwise =  do
      rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Ap (State VHDLState) [(Doc, Int)]
 -> Ap (State VHDLState) ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ (,Expr -> Int
forall {b}. Num b => Expr -> b
formalLength Expr
i) (Doc -> (Doc, Int)) -> VHDLM Doc -> Ap (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
i) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"=>" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e | (Expr
i,HWType
_,Expr
e) <- [(Expr, HWType, Expr)]
gens]
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (VHDLM Doc
"generic map" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
    pms2 :: VHDLM Doc
pms2 = do
      rec ([Doc]
p,[Int]
ls) <- case PortMap
pms0 of
                      NamedPortMap [(Expr, PortDirection, HWType, Expr)]
pms1 -> ([(Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Ap (State VHDLState) [(Doc, Int)]
 -> Ap (State VHDLState) ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [[Int] -> Expr -> Expr -> Ap (State VHDLState) (Doc, Int)
forall {t} {t :: Type -> Type}.
(Num t, Foldable t) =>
t Int -> Expr -> Expr -> Ap (State VHDLState) (Doc, t)
pm [Int]
ls Expr
i Expr
e | (Expr
i,PortDirection
_,HWType
_,Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms1]
                      IndexedPortMap [(PortDirection, HWType, Expr)]
pms1 -> ([(Doc, Int)] -> ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Ap (State VHDLState) [(Doc, Int)]
 -> Ap (State VHDLState) ([Doc], [Int]))
-> Ap (State VHDLState) [(Doc, Int)]
-> Ap (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Ap (State VHDLState) (Doc, Int)]
-> Ap (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [Expr -> Ap (State VHDLState) (Doc, Int)
forall {t}. Num t => Expr -> Ap (State VHDLState) (Doc, t)
pmi Expr
e | (PortDirection
_,HWType
_,Expr
e) <- [(PortDirection, HWType, Expr)]
pms1]
      Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
"port map" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Doc] -> Ap (State VHDLState) [Doc]
forall a. a -> Ap (State VHDLState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p)

    pm :: t Int -> Expr -> Expr -> Ap (State VHDLState) (Doc, t)
pm t Int
ls Expr
i Expr
e = (,Expr -> t
forall {b}. Num b => Expr -> b
formalLength Expr
i) (Doc -> (Doc, t)) -> VHDLM Doc -> Ap (State VHDLState) (Doc, t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill (t Int -> Int
forall a. Ord a => t a -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum t Int
ls) (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
i) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"=>" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e
    pmi :: Expr -> Ap (State VHDLState) (Doc, t)
pmi Expr
e = (,t
0) (Doc -> (Doc, t)) -> VHDLM Doc -> Ap (State VHDLState) (Doc, t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e

    formalLength :: Expr -> b
formalLength (Identifier Identifier
i Maybe Modifier
_) = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
TextS.length (Identifier -> Text
Id.toText Identifier
i))
    formalLength Expr
_                = b
0
    entOrComp' :: VHDLM Doc
entOrComp' = case EntityOrComponent
entOrComp of { EntityOrComponent
Entity -> VHDLM Doc
" entity"; EntityOrComponent
Comp -> VHDLM Doc
" component"; EntityOrComponent
Empty -> VHDLM Doc
""}

inst_ (BlackBoxD Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx) =
  (Doc -> Maybe Doc) -> VHDLM Doc -> Ap (State VHDLState) (Maybe Doc)
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (State VHDLState Doc -> VHDLM Doc
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState (Int -> Doc) -> State VHDLState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State VHDLState (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx)))

inst_ (ConditionalDecl Text
cond [Declaration]
_) = do
  String -> Ap (State VHDLState) ()
forall (f :: Type -> Type). Applicative f => String -> f ()
traceM
    (String -> Ap (State VHDLState) ())
-> String -> Ap (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ String
"WARNING: Conditional compilation is not supported in VHDL. Discarding code conditional on "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
TextS.unpack Text
cond
  Maybe Doc -> Ap (State VHDLState) (Maybe Doc)
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

inst_ Declaration
_ = Maybe Doc -> Ap (State VHDLState) (Maybe Doc)
forall a. a -> Ap (State VHDLState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

-- | Render a data constructor application for data constructors having a
-- custom bit representation.
customReprDataCon
  :: DataRepr'
  -- ^ Custom representation of data type
  -> ConstrRepr'
  -- ^ Custom representation of a specific constructor of @dataRepr@
  -> [(HWType, Expr)]
  -- ^ Arguments applied to constructor
  -> VHDLM Doc
customReprDataCon :: DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> VHDLM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
constrRepr [(HWType, Expr)]
args =
  VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & " (Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc])
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ (BitOrigin -> VHDLM Doc)
-> [BitOrigin] -> Ap (State VHDLState) [Doc]
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 BitOrigin -> VHDLM Doc
range [BitOrigin]
origins)
    where
      DataRepr' Type'
_typ Int
size [ConstrRepr']
_constrs = DataRepr'
dataRepr

      -- Build bit representations for all constructor arguments
      argSLVs :: [VHDLM Doc]
argSLVs = ((HWType, Expr) -> VHDLM Doc) -> [(HWType, Expr)] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((HWType -> Expr -> VHDLM Doc) -> (HWType, Expr) -> VHDLM Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV) [(HWType, Expr)]
args :: [VHDLM Doc]

      -- Spread bits of constructor arguments using masks
      origins :: [BitOrigin]
origins = DataRepr' -> ConstrRepr' -> [BitOrigin]
bitOrigins DataRepr'
dataRepr ConstrRepr'
constrRepr :: [BitOrigin]

      range
        :: BitOrigin
        -> VHDLM Doc
      range :: BitOrigin -> VHDLM Doc
range (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
        VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ (Bit -> VHDLM Doc) -> [Bit] -> Ap (State VHDLState) [Doc]
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 Bit -> VHDLM Doc
bit_char [Bit]
ns
      range (Field Int
n Int
start Int
end) =
        -- We want to select the bits starting from 'start' downto and including
        -- 'end'. We cannot use "(start downto end)" in VHDL, as the preceeding
        -- expression might be anything. This notation only works on identifiers
        -- unfortunately.
        let fsize :: Int
fsize = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in
        let expr' :: VHDLM Doc
expr' = [VHDLM Doc]
argSLVs [VHDLM Doc] -> Int -> VHDLM Doc
forall a. HasCallStack => [a] -> Int -> a
!! Int
n in

        -- HACK: While expr' is a std_logic_vector (see call `toSLV`), it cannot
        -- be cast to unsigned in case of literals. This is fixed by explicitly
        -- casting it to std_logic_vector.
        let unsigned :: VHDLM Doc
unsigned = VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
expr') in

        if | Int
fsize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size ->
               -- If sizes are equal, rotating / resizing amounts to doing nothing
               VHDLM Doc
expr'
           | Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
               -- Rotating is not necessary if relevant bits are already at the end
               let resized :: VHDLM Doc
resized = VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
unsigned VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize) in
               VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
resized
           | Bool
otherwise ->
               -- Select bits 'start' downto and including 'end'
               let rotated :: VHDLM Doc
rotated  = VHDLM Doc
unsigned VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"srl" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end in
               let resized :: VHDLM Doc
resized = VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
rotated VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize) in
               VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
resized

-- | Turn a Netlist expression into a VHDL expression
expr_
  :: HasCallStack
  => Bool
  -- ^ Enclose in parentheses?
  -> Expr
  -- ^ Expr to convert
  -> VHDLM Doc
expr_ :: HasCallStack => Bool -> Expr -> VHDLM Doc
expr_ Bool
_ (Literal Maybe (HWType, Int)
sizeM Literal
lit) = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit Maybe (HWType, Int)
sizeM Literal
lit
expr_ Bool
_ (Identifier Identifier
id_ Maybe Modifier
Nothing) = Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_

expr_ Bool
_ (Identifier Identifier
id_ (Just Modifier
m)) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  VHDLM Doc
-> ([(VHDLModifier, HWType)] -> VHDLM Doc)
-> Maybe [(VHDLModifier, HWType)]
-> VHDLM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) (((VHDLModifier, HWType) -> VHDLM Doc -> VHDLM Doc)
-> VHDLM Doc -> [(VHDLModifier, HWType)] -> VHDLM Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (VHDLModifier, HWType) -> VHDLM Doc -> VHDLM Doc
renderModifier (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)) (HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [] Modifier
m)

expr_ Bool
b (DataCon HWType
_ (DC (Void {}, -1)) [Expr
e]) =  HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
b Expr
e

expr_ Bool
_ (DataCon ty :: HWType
ty@(Vector Int
0 HWType
_) Modifier
_ [Expr]
_) = HWType -> VHDLM Doc
sizedQualTyNameErrValue HWType
ty

expr_ Bool
_ (DataCon ty :: HWType
ty@(Vector Int
1 HWType
elTy) Modifier
_ [Expr
e])       = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV HWType
elTy Expr
e)
    HdlSyn
_ -> HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
expr_ Bool
_ e :: Expr
e@(DataCon ty :: HWType
ty@(Vector Int
_ HWType
elTy) Modifier
_ [Expr
e1,Expr
e2]) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    -- When targeting Vivado, arrays must use std_logic_vector for elements.
    HdlSyn
Vivado -> HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> case Expr -> Maybe [Expr]
vectorChain Expr
e of
      Just [Expr]
es -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((Expr -> VHDLM Doc) -> [Expr] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV HWType
elTy) [Expr]
es))
      Maybe [Expr]
Nothing -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV HWType
elTy Expr
e1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"&" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e2)
    HdlSyn
_ -> HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> case Expr -> Maybe [Expr]
vectorChain Expr
e of
            Just [Expr]
es -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((Expr -> VHDLM Doc) -> [Expr] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False) [Expr]
es))
            Maybe [Expr]
Nothing -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> VHDLM Doc
qualTyName HWType
elTy VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"&" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e2)

expr_ Bool
_ (DataCon ty :: HWType
ty@(MemBlob Int
n Int
m) Modifier
_ [Expr
n0, Expr
m0, Expr
_, Expr
runs, Expr
_, Expr
ends])
  | Literal Maybe (HWType, Int)
_ (NumLit Integer
n1) <- Expr
n0
  , Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n1
  , Literal Maybe (HWType, Int)
_ (NumLit Integer
m1) <- Expr
m0
  , Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m1
  , Literal Maybe (HWType, Int)
Nothing (StringLit String
runs0) <- Expr
runs
  , Literal Maybe (HWType, Int)
Nothing (StringLit String
ends0) <- Expr
ends
  , [Natural]
es <- Int -> Int -> ByteString -> ByteString -> [Natural]
unpackNats Int
n Int
m (String -> ByteString
B8.pack String
runs0) (String -> ByteString
B8.pack String
ends0) =
    let el :: Natural -> VHDLM Doc
el Natural
val = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector Int
m, Int
m)) (Integer -> Integer -> Literal
BitVecLit Integer
0 (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
val)
    in HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> (VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ (Natural -> VHDLM Doc) -> [Natural] -> Ap (State VHDLState) [Doc]
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 Natural -> VHDLM Doc
el [Natural]
es)

expr_ Bool
_ (DataCon ty :: HWType
ty@(RTree Int
0 HWType
elTy) Modifier
_ [Expr
e]) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV HWType
elTy Expr
e)
    HdlSyn
_ -> HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
expr_ Bool
_ e :: Expr
e@(DataCon ty :: HWType
ty@(RTree Int
d HWType
elTy) Modifier
_ [Expr
e1,Expr
e2]) = HWType -> VHDLM Doc
qualTyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> case Expr -> Maybe [Expr]
rtreeChain Expr
e of
  Just [Expr]
es -> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((Expr -> VHDLM Doc) -> [Expr] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False) [Expr]
es)
  Maybe [Expr]
Nothing -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> VHDLM Doc
qualTyName (Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
elTy) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e1) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                     VHDLM Doc
"&" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e2)

expr_ Bool
_ (DataCon (SP {}) (DC (BitVector Int
_,Int
_)) [Expr]
es) = VHDLM Doc
assignExpr
  where
    argExprs :: [VHDLM Doc]
argExprs   = (Expr -> VHDLM Doc) -> [Expr] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc -> VHDLM Doc)
-> (Expr -> VHDLM Doc) -> Expr -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False) [Expr]
es
    assignExpr :: VHDLM Doc
assignExpr = VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & " (Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc])
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [VHDLM Doc]
argExprs)

expr_ Bool
_ (DataCon ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = VHDLM Doc
assignExpr
  where
    argTys :: [HWType]
argTys     = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Text, [HWType])]
args [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
    dcSize :: Int
dcSize     = HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
argTys)
    dcExpr :: VHDLM Doc
dcExpr     = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
    argExprs :: [VHDLM Doc]
argExprs   = (VHDLM Doc -> VHDLM Doc) -> [VHDLM Doc] -> [VHDLM Doc]
forall a b. (a -> b) -> [a] -> [b]
map VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ((HWType -> Expr -> VHDLM Doc) -> [HWType] -> [Expr] -> [VHDLM Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV [HWType]
argTys [Expr]
es)
    extraArg :: [VHDLM Doc]
extraArg   = case HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dcSize of
                   Int
0 -> []
                   Int
n -> [[Bit] -> VHDLM Doc
bits (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
    assignExpr :: VHDLM Doc
assignExpr = VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & " (Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc])
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ [VHDLM Doc] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence (VHDLM Doc
dcExprVHDLM Doc -> [VHDLM Doc] -> [VHDLM Doc]
forall a. a -> [a] -> [a]
:[VHDLM Doc]
argExprs [VHDLM Doc] -> [VHDLM Doc] -> [VHDLM Doc]
forall a. [a] -> [a] -> [a]
++ [VHDLM Doc]
extraArg))

expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum Text
_ [Text]
_) (DC (HWType
_,Int
i)) []) = do
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  if Bool
enums then
    HWType -> VHDLM Doc
tyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => HWType -> Int -> VHDLM Doc
HWType -> Int -> VHDLM Doc
enumVariantName HWType
ty Int
i)
  else
    HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
expr_ Bool
_ (DataCon ty :: HWType
ty@(CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
tys) (DC (HWType
_,Int
i)) []) =
  let (ConstrRepr' Text
_ Int
_ Integer
_ Integer
value [Integer]
_) = (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Text) -> ConstrRepr')
-> (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Text)]
tys [(ConstrRepr', Text)] -> Int -> (ConstrRepr', Text)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"to_unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty)))
expr_ Bool
_ (DataCon (CustomSP Text
_ DataRepr'
dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) =
  let (ConstrRepr'
cRepr, Text
_, [HWType]
argTys) = [(ConstrRepr', Text, [HWType])]
args [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> VHDLM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipEqual [HWType]
argTys [Expr]
es)
expr_ Bool
_ (DataCon (CustomProduct Text
_ DataRepr'
dataRepr Int
_size Maybe [Text]
_labels [(Integer, HWType)]
tys) Modifier
_ [Expr]
es) |
  DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> VHDLM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipEqual (((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd [(Integer, HWType)]
tys) [Expr]
es)

expr_ Bool
_ (DataCon ty :: HWType
ty@(Product Text
_ Maybe [Text]
labels [HWType]
tys) Modifier
_ [Expr]
es) =
    Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ (Int -> Expr -> VHDLM Doc)
-> [Int] -> [Expr] -> Ap (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i Expr
e' -> HWType -> VHDLM Doc
tyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
i VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
rarrow VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e') [Int
0..] [Expr]
es

expr_ Bool
_ (DataCon (Enable Text
_) Modifier
_ [Expr
e]) =
  HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Signed.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Unsigned.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , NumLit Integer
m' <- Literal
m
  , NumLit Integer
i' <- Literal
i
  = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) (Integer -> Integer -> Literal
BitVecLit Integer
m' Integer
i')

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger##"
  , [Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , NumLit Integer
m' <- Literal
m
  , NumLit Integer
i' <- Literal
i
  = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bit,Int
1)) (Bit -> Literal
BitLit (Bit -> Literal) -> Bit -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Bit
toBit Integer
m' Integer
i')

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Index.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , Just Int
k <- Integer -> Integer -> Maybe Int
clogBase Integer
2 Integer
n
  , let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
  = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Integer -> HWType
Index Integer
n,Int
k')) Literal
i

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Index.maxBound#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
  , Just Int
k <- Integer -> Integer -> Maybe Int
clogBase Integer
2 Integer
n
  , let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
  = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
k',Int
k')) (Integer -> Literal
NumLit (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1))

expr_ Bool
b (BlackBoxE Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx Bool
b') = do
  Bool -> VHDLM Doc -> VHDLM Doc
forall (m :: Type -> Type). Monad m => Bool -> Ap m Doc -> Ap m Doc
parenIf (Bool
b Bool -> Bool -> Bool
|| Bool
b') (State VHDLState Doc -> VHDLM Doc
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State VHDLState (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx State VHDLState (Int -> Doc)
-> State VHDLState Int -> State VHDLState Doc
forall a b.
State VHDLState (a -> b) -> State VHDLState a -> State VHDLState b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> State VHDLState Int
forall a. a -> StateT VHDLState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0))

expr_ Bool
_ (DataTag HWType
Bool (Left Identifier
id_)) = VHDLM Doc
"tagToEnum" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)
expr_ Bool
_ (DataTag HWType
Bool (Right Identifier
id_)) = VHDLM Doc
"dataToTag" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)

expr_ Bool
_ (DataTag hty :: HWType
hty@(Sum Text
_ [Text]
_) (Left Identifier
id_)) = do
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm

  let inner :: VHDLM Doc
inner = VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
hty)))
  if Bool
enums then Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
inner else VHDLM Doc
inner

expr_ Bool
_ (DataTag (Sum Text
_ [Text]
_) (Right Identifier
id_)) = do
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm

  let inner :: VHDLM Doc
inner = if Bool
enums then Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) else Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
  VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
inner VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))

expr_ Bool
_ (DataTag (Product {}) (Right Identifier
_))  = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag hty :: HWType
hty@(SP Text
_ [(Text, [HWType])]
_) (Right Identifier
id_)) = do {
    ; Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
    ; VHDLM Doc
"signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (
      VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
                          VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))
    }
  where
    start :: Int
start = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    end :: Int
end   = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
hty

expr_ Bool
_ (DataTag (Vector Int
0 HWType
_) (Right Identifier
_)) = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag (Vector Int
_ HWType
_) (Right Identifier
_)) = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)

expr_ Bool
_ (DataTag (RTree Int
0 HWType
_) (Right Identifier
_)) = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag (RTree Int
_ HWType
_) (Right Identifier
_)) = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Int -> Ap (State VHDLState) Int)
-> State VHDLState Int -> Ap (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)

expr_ Bool
_ (ToBv Maybe Identifier
topM HWType
hwty Expr
e) = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  case Maybe Identifier
topM of
    Maybe Identifier
Nothing -> Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
               VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> VHDLM Doc
qualTyName HWType
hwty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e))
    Just Identifier
t  -> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)

expr_ Bool
_ (FromBv Maybe Identifier
topM HWType
hwty Expr
e) = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  HWType -> VHDLM Doc
qualTyName HWType
hwty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
    (VHDLM Doc
-> (Identifier -> VHDLM Doc) -> Maybe Identifier -> VHDLM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types" ) (\Identifier
t -> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types") Maybe Identifier
topM VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
     VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e))

expr_ Bool
_ Expr
e = String -> VHDLM Doc
forall a. HasCallStack => String -> a
error (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr -> String
forall a. Show a => a -> String
show Expr
e) -- empty

otherSize :: [HWType] -> Int -> Int
otherSize :: [HWType] -> Int -> Int
otherSize [HWType]
_ Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int
0
otherSize []     Int
_    = Int
0
otherSize (HWType
a:[HWType]
as) Int
n    = HWType -> Int
typeSize HWType
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [HWType] -> Int -> Int
otherSize [HWType]
as (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

vectorChain :: Expr -> Maybe [Expr]
vectorChain :: Expr -> Maybe [Expr]
vectorChain (DataCon (Vector Int
0 HWType
_) Modifier
_ [Expr]
_)        = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just []
vectorChain (DataCon (Vector Int
1 HWType
_) Modifier
_ [Expr
e])     = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just [Expr
e]
vectorChain (DataCon (Vector Int
_ HWType
_) Modifier
_ [Expr
e1,Expr
e2]) = Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e1 Maybe Expr -> Maybe [Expr] -> Maybe [Expr]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Expr -> Maybe [Expr]
vectorChain Expr
e2
vectorChain Expr
_                                       = Maybe [Expr]
forall a. Maybe a
Nothing

rtreeChain :: Expr -> Maybe [Expr]
rtreeChain :: Expr -> Maybe [Expr]
rtreeChain (DataCon (RTree Int
1 HWType
_) Modifier
_ [Expr
e])     = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just [Expr
e]
rtreeChain (DataCon (RTree Int
_ HWType
_) Modifier
_ [Expr
e1,Expr
e2]) = ([Expr] -> [Expr] -> [Expr])
-> Maybe [Expr] -> Maybe [Expr] -> Maybe [Expr]
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
(++) (Expr -> Maybe [Expr]
rtreeChain Expr
e1) (Expr -> Maybe [Expr]
rtreeChain Expr
e2)
rtreeChain Expr
_ = Maybe [Expr]
forall a. Maybe a
Nothing

exprLit :: Maybe (HWType,Size) -> Literal -> VHDLM Doc
exprLit :: Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit Maybe (HWType, Int)
Nothing (NumLit Integer
i) = Integer -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i

exprLit (Just (HWType
hty,Int
sz)) (NumLit Integer
i) = case HWType
hty of
  Unsigned Int
n
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (-Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
31 :: Integer))-> VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"signed'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
lit))
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0                    -> VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens(Integer -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)))
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
31 :: Integer) -> VHDLM Doc
"to_unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Integer -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
    | Bool
otherwise -> VHDLM Doc
"unsigned'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
lit
  Index Integer
n
   | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n -> Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
sz, Int
sz)) (Integer -> Literal
NumLit Integer
i)  -- reuse Unsigned implementation above
   | Bool
otherwise       -> HWType -> VHDLM Doc
forall state. Backend state => HWType -> Ap (State state) Doc
hdlTypeErrValue HWType
hty
  Signed Int
n
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
31 :: Integer) Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (-Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
31 :: Integer)) -> VHDLM Doc
"to_signed" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Integer -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Integer -> f Doc
integer Integer
i VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
    | Bool
otherwise -> VHDLM Doc
"signed'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
lit
  BitVector Int
_ -> VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
lit
  HWType
Bit         -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2))
  HWType
_           -> VHDLM Doc
blit

  where
    validHexLit :: Bool
validHexLit = Int
sz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    lit :: VHDLM Doc
lit = if Bool
validHexLit then VHDLM Doc
hlit else VHDLM Doc
blit
    blit :: VHDLM Doc
blit = [Bit] -> VHDLM Doc
bits (Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz Integer
i)
    i' :: Integer
i'   = case HWType
hty of
             Signed Int
_ -> let mask :: Integer
mask = Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) in case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
mask of
                (Integer
s,Integer
i'') | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
s    -> Integer
i''
                        | Bool
otherwise -> Integer
i'' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
mask
             HWType
_ -> Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz
    hlit :: VHDLM Doc
hlit = (if Integer
i' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then VHDLM Doc
"-" else VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> String -> VHDLM Doc
hex (Int -> Integer -> String
toHex Int
sz Integer
i')

exprLit (Just (HWType
hty,Int
sz)) (BitVecLit Integer
m Integer
i) = case Integer
m of
  Integer
0 -> Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
hty,Int
sz)) (Integer -> Literal
NumLit Integer
i)
  Integer
_ -> VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
bvlit
  where
    bvlit :: VHDLM Doc
bvlit = [Bit] -> VHDLM Doc
bits (Int -> Integer -> Integer -> [Bit]
forall a. Integral a => Int -> a -> a -> [Bit]
toBits' Int
sz Integer
m Integer
i)


exprLit Maybe (HWType, Int)
_             (BoolLit Bool
t)   = if Bool
t then VHDLM Doc
"true" else VHDLM Doc
"false"
exprLit Maybe (HWType, Int)
_             (BitLit Bit
b)    = VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ Bit -> VHDLM Doc
bit_char Bit
b
exprLit Maybe (HWType, Int)
_             (StringLit String
s) = Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> VHDLM Doc) -> (String -> Text) -> String -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
s
exprLit Maybe (HWType, Int)
_             Literal
l             = String -> VHDLM Doc
forall a. HasCallStack => String -> a
error (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"exprLit: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Literal -> String
forall a. Show a => a -> String
show Literal
l

patLit :: HWType -> Literal -> VHDLM Doc
patLit :: HWType -> Literal -> VHDLM Doc
patLit HWType
Bit (NumLit Integer
i) = if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then VHDLM Doc
"'0'" else VHDLM Doc
"'1'"
patLit HWType
hwty (NumLit Integer
i) = do
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums

  case HWType
hwty of
    Sum{} | Bool
enums ->
      HWType -> VHDLM Doc
tyName HWType
hwty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => HWType -> Int -> VHDLM Doc
HWType -> Int -> VHDLM Doc
enumVariantName HWType
hwty (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i))

    HWType
_ ->
      let sz :: Int
sz = HWType -> Int
conSize HWType
hwty
       in case Int
sz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 of
            Int
0 -> String -> VHDLM Doc
hex  (Int -> Integer -> String
toHex Int
sz Integer
i)
            Int
_ -> [Bit] -> VHDLM Doc
bits (Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz Integer
i)

patLit HWType
_    Literal
l          = Maybe (HWType, Int) -> Literal -> VHDLM Doc
exprLit Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
l

patMod :: HWType -> Literal -> Literal
patMod :: HWType -> Literal -> Literal
patMod HWType
hwTy (NumLit Integer
i) = Integer -> Literal
NumLit (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ HWType -> Int
typeSize HWType
hwTy))
patMod HWType
_ Literal
l = Literal
l

toBits :: Integral a => Int -> a -> [Bit]
toBits :: forall a. Integral a => Int -> a -> [Bit]
toBits Int
size a
val = (a -> Bit) -> [a] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
forall a. Integral a => a -> Bool
odd a
x then Bit
H else Bit
L)
                ([a] -> [Bit]) -> [a] -> [Bit]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse
                ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
size
                ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2)
                ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a
val

toBits' :: Integral a => Int -> a -> a -> [Bit]
toBits' :: forall a. Integral a => Int -> a -> a -> [Bit]
toBits' Int
size a
msk a
val = ((a, a) -> Bit) -> [(a, a)] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
m,a
i) -> if a -> Bool
forall a. Integral a => a -> Bool
odd a
m then Bit
U else (if a -> Bool
forall a. Integral a => a -> Bool
odd a
i then Bit
H else Bit
L))
                ([(a, a)] -> [Bit]) -> [(a, a)] -> [Bit]
forall a b. (a -> b) -> a -> b
$
                ( [(a, a)] -> [(a, a)]
forall a. [a] -> [a]
reverse ([(a, a)] -> [(a, a)])
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> [(a, a)]
forall a. Int -> [a] -> [a]
take Int
size)
                ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
                  ( (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a
msk)
                  ( (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a
val)

bits :: [Bit] -> VHDLM Doc
bits :: [Bit] -> VHDLM Doc
bits = VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (VHDLM Doc -> VHDLM Doc)
-> ([Bit] -> VHDLM Doc) -> [Bit] -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> ([Bit] -> Ap (State VHDLState) [Doc]) -> [Bit] -> VHDLM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> VHDLM Doc) -> [Bit] -> Ap (State VHDLState) [Doc]
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 Bit -> VHDLM Doc
bit_char

toHex :: Int -> Integer -> String
toHex :: Int -> Integer -> String
toHex Int
sz Integer
i = case Integer -> Integer -> Maybe Int
clogBase Integer
16 (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz) of
  Just Int
d -> String -> Integer -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"X") (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
  Maybe Int
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"toHex: impossible"

hex :: String -> VHDLM Doc
hex :: String -> VHDLM Doc
hex String
s = Char -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'x' VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (String -> Text
T.pack String
s))

bit_char :: Bit -> VHDLM Doc
bit_char :: Bit -> VHDLM Doc
bit_char Bit
H = Char -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'1'
bit_char Bit
L = Char -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'0'
bit_char Bit
U = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Ap (State VHDLState) (Maybe (Maybe Int))
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Maybe (Maybe Int)
Nothing -> Char -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'-'
    Just Maybe Int
Nothing -> Char -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'0'
    Just (Just Int
i) -> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i
bit_char Bit
Z = Char -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'Z'

toSLV :: HasCallStack => HWType -> Expr -> VHDLM Doc
toSLV :: HasCallStack => HWType -> Expr -> VHDLM Doc
toSLV HWType
Bool         Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV HWType
Bit          Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Clock {})    Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (ClockN {})   Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Reset {})    Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Text
TextS.toLower Text
nm) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Enable Text
_)    Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (BitVector Int
_) Expr
e = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
True Expr
e
toSLV (Signed Int
_)   Expr
e = VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Unsigned Int
_) Expr
e = VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Index Integer
_)    Expr
e = VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Sum Text
_ [Text]
_)    Expr
e = do
  RenderEnums Bool
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  if Bool
enums then do
    Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
    Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
  else
    HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e
toSLV (CustomSum Text
_ DataRepr'
_dataRepr Int
size [(ConstrRepr', Text)]
reprs) (DataCon HWType
_ (DC (HWType
_,Int
i)) [Expr]
_) =
  let (ConstrRepr' Text
_ Int
_ Integer
_ Integer
value [Integer]
_) = (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Text) -> ConstrRepr')
-> (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Text)]
reprs [(ConstrRepr', Text)] -> Int -> (ConstrRepr', Text)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  let unsigned :: VHDLM Doc
unsigned = VHDLM Doc
"to_unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
size) in
  VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
unsigned
toSLV (CustomSum {}) Expr
e = VHDLM Doc
"std_logic_vector" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV t :: HWType
t@(Product Text
_ Maybe [Text]
labels [HWType]
tys) (Identifier Identifier
id_ Maybe Modifier
Nothing) = do
    [Expr]
selIds' <- [Ap (State VHDLState) Expr] -> Ap (State VHDLState) [Expr]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [Ap (State VHDLState) Expr]
selIds
    VHDLM Doc
-> VHDLM Doc
-> VHDLM Doc
-> Ap (State VHDLState) [Doc]
-> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen VHDLM Doc
" & " ((HWType -> Expr -> VHDLM Doc)
-> [HWType] -> [Expr] -> Ap (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV [HWType]
tys [Expr]
selIds')
  where
    tName :: VHDLM Doc
tName    = HWType -> VHDLM Doc
tyName HWType
t
    selNames :: [Ap (State VHDLState) Identifier]
selNames = (VHDLM Doc -> Ap (State VHDLState) Identifier)
-> [VHDLM Doc] -> [Ap (State VHDLState) Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Identifier) -> VHDLM Doc -> Ap (State VHDLState) Identifier
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) ) [Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
tName VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
i | Int
i <- [Int
0..([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]]
    selIds :: [Ap (State VHDLState) Expr]
selIds   = (Ap (State VHDLState) Identifier -> Ap (State VHDLState) Expr)
-> [Ap (State VHDLState) Identifier] -> [Ap (State VHDLState) Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Expr)
-> Ap (State VHDLState) Identifier -> Ap (State VHDLState) Expr
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Identifier
n -> Identifier -> Maybe Modifier -> Expr
Identifier Identifier
n Maybe Modifier
forall a. Maybe a
Nothing)) [Ap (State VHDLState) Identifier]
selNames
toSLV (Product Text
_ Maybe [Text]
_ [HWType]
tys) (DataCon HWType
_ Modifier
_ [Expr]
es) | [HWType] -> [Expr] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [HWType]
tys [Expr]
es =
  -- Need equalLenght for code seen in ZipWithUnitVector
  VHDLM Doc
-> VHDLM Doc
-> VHDLM Doc
-> Ap (State VHDLState) [Doc]
-> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen VHDLM Doc
" & " ((HWType -> Expr -> VHDLM Doc)
-> [HWType] -> [Expr] -> Ap (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV [HWType]
tys [Expr]
es)
toSLV (CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ [(Integer, HWType)]
_) Expr
e = do
  -- Custom representations are represented as bitvectors in HDL, so we don't
  -- need to do anything.
  HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e
toSLV t :: HWType
t@(Product Text
_ Maybe [Text]
_ [HWType]
_) Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e))
toSLV (SP Text
_ [(Text, [HWType])]
_) Expr
e       = HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e
toSLV (CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_) Expr
e =
  -- Custom representations are represented as bitvectors in HDL, so we don't
  -- need to do anything.
  HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e
toSLV (Vector Int
n HWType
elTy) (Identifier Identifier
id_ Maybe Modifier
Nothing) = do
    [Expr]
selIds' <- [Ap (State VHDLState) Expr] -> Ap (State VHDLState) [Expr]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [Ap (State VHDLState) Expr]
selIds
    HdlSyn
syn <- State VHDLState HdlSyn -> Ap (State VHDLState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & "
      (case HdlSyn
syn of
        HdlSyn
Vivado -> (Expr -> VHDLM Doc) -> [Expr] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False) [Expr]
selIds'
        HdlSyn
_ -> (Expr -> VHDLM Doc) -> [Expr] -> Ap (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV HWType
elTy) [Expr]
selIds'))
  where
    selNames :: [Ap (State VHDLState) Identifier]
selNames = (VHDLM Doc -> Ap (State VHDLState) Identifier)
-> [VHDLM Doc] -> [Ap (State VHDLState) Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Identifier) -> VHDLM Doc -> Ap (State VHDLState) Identifier
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) ) ([VHDLM Doc] -> [Ap (State VHDLState) Identifier])
-> [VHDLM Doc] -> [Ap (State VHDLState) Identifier]
forall a b. (a -> b) -> a -> b
$ [Identifier -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i) | Int
i <- [Int
0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]
    selIds :: [Ap (State VHDLState) Expr]
selIds   = (Ap (State VHDLState) Identifier -> Ap (State VHDLState) Expr)
-> [Ap (State VHDLState) Identifier] -> [Ap (State VHDLState) Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Expr)
-> Ap (State VHDLState) Identifier -> Ap (State VHDLState) Expr
forall a b.
(a -> b) -> Ap (State VHDLState) a -> Ap (State VHDLState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identifier -> Maybe Modifier -> Expr
`Identifier` Maybe Modifier
forall a. Maybe a
Nothing)) [Ap (State VHDLState) Identifier]
selNames
-- Don't split up newtype wrappers, or void-filtered types
toSLV (Vector Int
_ HWType
_) e :: Expr
e@(DataCon HWType
_ (DC (Void Maybe HWType
Nothing, -1)) [Expr]
_) = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (Vector Int
n HWType
elTy) (DataCon HWType
_ Modifier
_ [Expr]
es) =
  VHDLM Doc
"std_logic_vector'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> (VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State VHDLState) [Doc] -> VHDLM Doc)
-> Ap (State VHDLState) [Doc] -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & " ((HWType -> Expr -> VHDLM Doc)
-> [HWType] -> [Expr] -> Ap (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> VHDLM Doc
HWType -> Expr -> VHDLM Doc
toSLV [HWType
elTy,Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
elTy] [Expr]
es))
toSLV (Vector Int
_ HWType
_) Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State VHDLState Text -> Ap (State VHDLState) Text)
-> State VHDLState Text -> Ap (State VHDLState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV (RTree Int
_ HWType
_) Expr
e = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm)
  Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Text
TextS.toLower Text
nm) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.toSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> VHDLM Doc
Bool -> Expr -> VHDLM Doc
expr_ Bool
False Expr
e)
toSLV HWType
hty Expr
e = String -> VHDLM Doc
forall a. HasCallStack => String -> a
error (String -> VHDLM Doc) -> String -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"toSLV:\n\nType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
hty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nExpression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e

dcToExpr :: HWType -> Int -> Expr
dcToExpr :: HWType -> Int -> Expr
dcToExpr HWType
ty Int
i = Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
ty,HWType -> Int
conSize HWType
ty)) (Integer -> Literal
NumLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i))

larrow :: VHDLM Doc
larrow :: VHDLM Doc
larrow = VHDLM Doc
"<="

rarrow :: VHDLM Doc
rarrow :: VHDLM Doc
rarrow = VHDLM Doc
"=>"

parenIf :: Monad m => Bool -> Ap m Doc -> Ap m Doc
parenIf :: forall (m :: Type -> Type). Monad m => Bool -> Ap m Doc -> Ap m Doc
parenIf Bool
True  = Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
parenIf Bool
False = Ap m Doc -> Ap m Doc
forall a. a -> a
id

punctuate' :: Monad m => Ap m Doc -> Ap m [Doc] -> Ap m Doc
punctuate' :: forall (m :: Type -> Type).
Monad m =>
Ap m Doc -> Ap m [Doc] -> Ap m Doc
punctuate' Ap m Doc
s Ap m [Doc]
d = Ap m [Doc] -> Ap m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap m Doc -> Ap m [Doc] -> Ap m [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Ap m Doc
s Ap m [Doc]
d) Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc
s

encodingNote :: HWType -> VHDLM Doc
encodingNote :: HWType -> VHDLM Doc
encodingNote (Clock Text
_)  = VHDLM Doc
"-- clock" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (ClockN Text
_) = VHDLM Doc
"-- clock (neg phase)" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (Reset Text
_)  = VHDLM Doc
"-- reset" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (Enable Text
_) = VHDLM Doc
"-- enable" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (Annotated [Attr Text]
_ HWType
t) = HWType -> VHDLM Doc
encodingNote HWType
t
encodingNote HWType
_          = VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

tupledSemi :: Applicative f => f [Doc] -> f Doc
tupledSemi :: forall (f :: Type -> Type). Applicative f => f [Doc] -> f Doc
tupledSemi = f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (f Doc -> f Doc) -> (f [Doc] -> f Doc) -> f [Doc] -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep (f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
flatAlt (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc) f Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen)
                                (f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
flatAlt (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen) f Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen)
                                (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc)

-- | VHDL name modifiers
data VHDLModifier
  -- | SLV slice (descending index)
  = Range    Range
  -- | Element selection
  | Idx      Int
  -- | Array slice (ascending index)
  | Slice    Int Int
  -- | Selected names
  | Select   (VHDLM Doc)
  -- | Projecting a 'Word#' out of a 'Word8', or 'Int#' ouf of an 'Int8', see
  -- [Note] integer projection
  | Resize
  -- | Projecting a 'Natural' out of a 'BitVector', see [Note] bitvector projection
  | ResizeAndConvert
  -- | Projecting the mask out of a 'BitVector', see [Note] mask projection
  | DontCare

-- | Create a sequence of VHDL name modifiers from our internal 'Modifier'
-- data type. Note that the modifiers are in "reverse" order, so build a
-- complete modified name using 'foldr' over the list by this function.
--
-- [Note] Continuing from an SLV slice
-- SOP and custom products are represented as std_logic_vector, this means that
-- their elements are also std_logic_vector. So when we project an element out
-- of an SOP or custom project, and want to do a further projection on that,
-- we have to do further SLV slicing; instead of e.g. creating a 'selected'
-- modifier. Finally, when we render the modified name, we have to check
-- whether the ultimately projected type needs to be converted from this SLV
-- slice, to the proper type.
buildModifier
  :: HasCallStack
  => HdlSyn
  -> [(VHDLModifier,HWType)]
  -- ^ The list of modifiers so far, note that this list is in reverse order
  -- in which they should eventually be applied to the name we want to modify
  -> Modifier
  -> Maybe [(VHDLModifier,HWType)]
  -- ^ 'Nothing' indicates that the 'Modifier' does not result into a VHDL name
  -- modifier. i.e. we can use the identifier as is; this happens when we get
  -- projections out of product types with only one non-zero field.
buildModifier :: HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Sliced (HWType
_,Int
start,Int
end)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
hty Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous Int
start Int
end),HWType
hty) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
 where
  hty :: HWType
hty = Int -> HWType
BitVector (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args),Int
dcI,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous Int
start Int
end),HWType
argTy) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
 where
  argTys :: [HWType]
argTys   = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd (String -> [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"SOP type: invalid constructor index" [(Text, [HWType])]
args Int
dcI)
  argTy :: HWType
argTy    = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"SOP type: invalid field index" [HWType]
argTys Int
fI
  argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
  other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  start :: Int
start    = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
  end :: Int
end      = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Product Text
_ Maybe [Text]
labels [HWType]
tys),Int
_,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
          otherSz :: Int
otherSz = [HWType] -> Int -> Int
otherSize [HWType]
tys (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
otherSz
          end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      let d :: VHDLM Doc
d = VHDLM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> VHDLM Doc
tyName HWType
ty VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
Maybe [Text] -> [HWType] -> Int -> VHDLM Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
fI
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLM Doc -> VHDLModifier
Select VHDLM Doc
d,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
 where
  argTy :: HWType
argTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Product type: invalid field index" [HWType]
tys Int
fI

buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
1,Int
0)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
          start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
start Int
_,Vector Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we just pick its first element
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
start,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
0,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM))

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Vector Int
n HWType
argTy),Int
1,Int
1)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
          start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
start Int
end,Vector Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we just pick the tail of that slice
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end,HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
 where
  tyN :: HWType
tyN = Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy

buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
_ HWType
argTy),Int
0,Int
0)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
start Int
_,RTree Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we just pick its first element
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
start,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
0,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM))

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
0)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          end :: Int
end   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
start Int
_,RTree Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we just pick the left half
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
start (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
0 (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
 where
  tyN :: HWType
tyN = Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy
  z :: Int
z   = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
1)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
_ Int
end,RTree Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we just pick the right half
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end,HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
z (Int
z'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
 where
  tyN :: HWType
tyN = Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy
  z :: Int
z   = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  z' :: Int
z'  = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
10,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
          start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
argSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
start Int
_,Vector Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we offset from its starting element
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI),HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy (((Int -> VHDLModifier
Idx Int
fI,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)))

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
_ HWType
argTy),Int
10,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
          start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
argSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          end :: Int
end     = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    | (Slice Int
start Int
_,RTree Int
1 HWType
argTyP) <- (VHDLModifier, HWType)
prev
    , HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
      -- If the last modifier was an array slice, we offset from its starting element
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI),HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
fI,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM))

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (CustomSP Text
_ DataRepr'
dataRepr Int
size [(ConstrRepr', Text, [HWType])]
args,Int
dcI,Int
fI))
  | Void {} <- HWType
argTy
  = String -> Maybe [(VHDLModifier, HWType)]
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
  | Bool
otherwise
  = case [(VHDLModifier, HWType)]
prevM of
    ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
      | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
        [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
    [(VHDLModifier, HWType)]
_ ->
        [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy (Int -> Int -> Range
Contiguous (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0)) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
 where
  (ConstrRepr' Text
_name Int
_n Integer
_mask Integer
_value [Integer]
anns, Text
_, [HWType]
argTys) =
    String
-> [(ConstrRepr', Text, [HWType])]
-> Int
-> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid constructor index" [(ConstrRepr', Text, [HWType])]
args Int
dcI
  ses :: [(Int, Int)]
ses = Integer -> [(Int, Int)]
bitRanges (String -> [Integer] -> Int -> Integer
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid annotation index" [Integer]
anns Int
fI)
  argTy :: HWType
argTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid field index" [HWType]
argTys Int
fI

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (CustomProduct Text
_ DataRepr'
dataRepr Int
size Maybe [Text]
_ [(Integer, HWType)]
args,Int
dcI,Int
fI))
  | Void {} <- HWType
argTy
  = String -> Maybe [(VHDLModifier, HWType)]
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
  | DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr
  , ConstrRepr' Text
_cName Int
_pos Integer
_mask Integer
_val [Integer]
fieldAnns <- ConstrRepr'
cRepr
  , let ses :: [(Int, Int)]
ses = Integer -> [(Int, Int)]
bitRanges (String -> [Integer] -> Int -> Integer
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom product type: invalid annotation index"
                         [Integer]
fieldAnns Int
fI)
  = case [(VHDLModifier, HWType)]
prevM of
      ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
        | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
          [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
      [(VHDLModifier, HWType)]
_ ->
          [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy (Int -> Int -> Range
Contiguous (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0))(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
 where
  argTy :: HWType
argTy = (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd (String -> [(Integer, HWType)] -> Int -> (Integer, HWType)
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom product type: invalid field index" [(Integer, HWType)]
args Int
fI)

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (DC (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
_),Int
_)) = case [(VHDLModifier, HWType)]
prevM of
  ((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
    | (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev -> -- See [Note] Continuing from an SLV slice
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
  [(VHDLModifier, HWType)]
_ ->
      [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous Int
start Int
end),HWType
tyN)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
 where
  start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  end :: Int
end   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty
  tyN :: HWType
tyN   = Int -> HWType
BitVector (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Nested Modifier
m1 Modifier
m2) = case HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM Modifier
m1 of
  Maybe [(VHDLModifier, HWType)]
Nothing -> HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM Modifier
m2
  Just [(VHDLModifier, HWType)]
prevM1 -> case HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM1 Modifier
m2 of
      -- In case the second modifier is `Nothing` that means we want the entire
      -- thing calculated by the first modifier
      Maybe [(VHDLModifier, HWType)]
Nothing -> [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just [(VHDLModifier, HWType)]
prevM1
      Maybe [(VHDLModifier, HWType)]
m       -> Maybe [(VHDLModifier, HWType)]
m

-- [Note] integer projection
--
-- The idea behind these expressions is to translate cases like:
--
-- > :: Int8 -> Int#
-- > \case I8# i -> i
--
-- Which is fine, because no bits are lost. However, these expression might
-- also be the result of the W/W transformation (or uses of unsafeToInteger)
-- for:
--
-- > :: Signed 128 -> Integer
-- > \case S i -> i
--
-- which is very bad because `Integer` is represented by 64 bits meaning we
-- we lose the top 64 bits in the above translation.
--
-- Just as bad is that
--
-- > :: Word8 -> Word#
-- > \case W8# w -> w
--
-- > :: Unsigned 8 -> Integer
-- > \case U i -> i
--
-- result in the same expression... even though their resulting types are
-- different. TODO: this needs  to be fixed!
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Signed Int
_),Int
_,Int
_)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
Resize,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Unsigned Int
_),Int
_,Int
_)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
Resize,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)

-- [Note] mask projection
--
-- This covers the case of either:
--
-- `Clash.Sized.Internal.BitVector.unsafeToMask` or
--
-- > :: BitVector 8 -> Integer
-- > \case BV m wild -> m
--
-- introduced by the W/W transformation. Both of which we prefer not to see
-- but will allow. Since the mask is pretty much a simulation artifact we
-- emit don't cares so stuff gets optimised away.
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(BitVector Int
_),Int
_,Int
0)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
DontCare,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)

-- [Note] bitvector projection
--
-- This covers the case of either:
--
-- `Clash.Sized.Internal.BitVector.unsafeToNatural` or
--
-- > :: BitVector 8 -> Integer
-- > \case BV wild i -> i
--
-- introduced by the W/W transformation. Both of which we prefer not to see
-- but will allow.
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(BitVector Int
_),Int
_,Int
1)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
ResizeAndConvert,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)

buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
_ Modifier
_ = Maybe [(VHDLModifier, HWType)]
forall a. Maybe a
Nothing

-- | Add an SLV slice for the entire element when we're in the Vivado code-path.
-- This is needed after an element projection from an array (Vec or RTree), as
-- elements are stored as SLVs in the Vivado code-path. This enabled two things:
--
-- 1. Nested modifiers treat the projected element as an SLV, and adjust their
--    projection behavior accordingly.
-- 2. Projected elements are converted from SLV to the proper VHDL type.
vivadoRange
  :: HdlSyn
  -> HWType
  -> [(VHDLModifier, HWType)]
  -> [(VHDLModifier, HWType)]
vivadoRange :: HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
ty [(VHDLModifier, HWType)]
mods = case HdlSyn
syn of
  HdlSyn
Vivado -> (Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous (HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0),HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
mods
  HdlSyn
_ -> [(VHDLModifier, HWType)]
mods

-- | Render a VHDL modifier on to of a (potentially modified) VHDL name
renderModifier
  :: (VHDLModifier,HWType)
  -> VHDLM Doc
  -- ^ (Potentially modified) VHDL name
  -> VHDLM Doc
  -- ^ Modified VHDL name
renderModifier :: (VHDLModifier, HWType) -> VHDLM Doc -> VHDLM Doc
renderModifier (Idx Int
n,HWType
_) VHDLM Doc
doc = VHDLM Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
renderModifier (Slice Int
start Int
end,HWType
_) VHDLM Doc
doc = VHDLM Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"to" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
renderModifier (Select VHDLM Doc
sel,HWType
_) VHDLM Doc
doc = VHDLM Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
sel
-- See [Note] integer projection
renderModifier (VHDLModifier
Resize,HWType
ty) VHDLM Doc
doc = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth)
  -- These integer projections always come last, so it's safe not to return a
  -- modified name, but an expression instead.
  Bool -> String -> VHDLM Doc -> VHDLM Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< HWType -> Int
typeSize HWType
ty) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$
    VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
renderModifier (VHDLModifier
ResizeAndConvert,HWType
ty) VHDLM Doc
doc = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth)
  -- These natural projections always come last, so it's safe not to return a
  -- modified name, but an expression instead.
  Bool -> String -> VHDLM Doc -> VHDLM Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< HWType -> Int
typeSize HWType
ty) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$
    VHDLM Doc
"resize" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (VHDLM Doc
"unsigned" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"," VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
-- See [Note] mask projection
renderModifier (VHDLModifier
DontCare,HWType
_) VHDLM Doc
_ = do
  Int
iw <- State VHDLState Int -> Ap (State VHDLState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth)
  -- These mask projections always come last, so it's safe not to return a
  -- modified name, but an expression instead.
  Bool -> String -> VHDLM Doc -> VHDLM Doc
forall a. Bool -> String -> a -> a
traceIf Bool
True ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: rendering bitvector mask as dontcare") (VHDLM Doc -> VHDLM Doc) -> VHDLM Doc -> VHDLM Doc
forall a b. (a -> b) -> a -> b
$
    HWType -> VHDLM Doc
sizedQualTyNameErrValue (Int -> HWType
Unsigned Int
iw)
renderModifier (Range Range
r,HWType
t) VHDLM Doc
doc = do
  Text
nm <- State VHDLState Text -> Ap (State VHDLState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting Text VHDLState Text -> State VHDLState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text VHDLState Text
Lens' VHDLState Text
modNm)
  RenderEnums
enums <- State VHDLState RenderEnums -> Ap (State VHDLState) RenderEnums
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State VHDLState RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  let doc1 :: VHDLM Doc
doc1 = case Range
r of
        Contiguous Int
start Int
end -> Int -> Int -> VHDLM Doc
slice Int
start Int
end
        Split [(Int, Int, Provenance)]
rs -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State VHDLState) [Doc] -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (VHDLM Doc
-> Ap (State VHDLState) [Doc] -> Ap (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate VHDLM Doc
" & " (((Int, Int, Provenance) -> VHDLM Doc)
-> [(Int, Int, Provenance)] -> Ap (State VHDLState) [Doc]
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 (\(Int
s,Int
e,Provenance
_) -> Int -> Int -> VHDLM Doc
slice Int
s Int
e) [(Int, Int, Provenance)]
rs)))
  case RenderEnums -> HWType -> HWType
normaliseType RenderEnums
enums HWType
t of
    BitVector Int
_ -> VHDLM Doc
doc1
    -- See [Note] Continuing from an SLV slice
    HWType
_ ->
      HWType -> VHDLM Doc
qualTyName HWType
t VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"'" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<>
      VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> VHDLM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Text
TextS.toLower Text
nm) VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc
"_types.fromSLV" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens VHDLM Doc
doc1)
 where
  slice :: Int -> Int -> VHDLM Doc
slice Int
s Int
e = VHDLM Doc
doc VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall a. Semigroup a => a -> a -> a
<> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> VHDLM Doc
"downto" VHDLM Doc -> VHDLM Doc -> VHDLM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> VHDLM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)