{-|
  Copyright   :  (C) 2015-2016, University of Twente,
                     2017-2018, Google Inc.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.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)
import           Control.Applicative                  (liftA2)
import           Control.Lens                         hiding (Indexed, Empty)
import           Control.Monad                        (forM,join,zipWithM)
import           Control.Monad.State                  (State, StateT)
import           Data.Bits                            (testBit, Bits)
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)
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid                          hiding (Sum, Product)
#endif
import           Data.Semigroup.Monad.Extra
import qualified Data.Text.Lazy                       as T
import qualified Data.Text                            as TextS

#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           TextShow                             (showt)

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.Backend
import           Clash.Core.Var                       (Attr'(..),attrName)
import           Clash.Debug                          (traceIf)
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, intWidth)
import           Clash.Netlist.Util
import           Clash.Util
  (SrcSpan, noSrcSpan, clogBase, curLoc, first, makeCached, on, indexNote)
import qualified Clash.Util.Interpolate               as I
import           Clash.Util.Graph                     (reverseTopSort)

import           Clash.Backend.Verilog (Range (..), continueWithRange)

-- | 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 -> 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 -> 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 -> AggressiveXOptBB
_aggressiveXOptBB_ :: AggressiveXOptBB
  }

makeLenses ''VHDLState

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

instance Backend VHDLState where
  initBackend :: Int
-> HdlSyn
-> Bool
-> PreserveCase
-> Maybe (Maybe Int)
-> AggressiveXOptBB
-> VHDLState
initBackend Int
w HdlSyn
hdlsyn_ Bool
esc PreserveCase
lw Maybe (Maybe Int)
undefVal AggressiveXOptBB
xOpt = VHDLState :: HashSet HWType
-> HashMap (HWType, Bool) Text
-> Text
-> SrcSpan
-> [Text]
-> [Text]
-> [(String, Doc)]
-> [(String, String)]
-> [(String, String)]
-> IdentifierSet
-> Int
-> HdlSyn
-> Maybe (Maybe Int)
-> HashMap (Maybe [Text], [HWType]) [Text]
-> AggressiveXOptBB
-> VHDLState
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
""
    , _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 Bool
esc PreserveCase
lw HDL
VHDL
    , _intWidth :: Int
_intWidth=Int
w
    , _hdlsyn :: HdlSyn
_hdlsyn=HdlSyn
hdlsyn_
    , _undefValue :: Maybe (Maybe Int)
_undefValue=Maybe (Maybe Int)
undefVal
    , _productFieldNameCache :: HashMap (Maybe [Text], [HWType]) [Text]
_productFieldNameCache=HashMap (Maybe [Text], [HWType]) [Text]
forall a. Monoid a => a
mempty
    , _aggressiveXOptBB_ :: AggressiveXOptBB
_aggressiveXOptBB_=AggressiveXOptBB
xOpt
    }
  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 (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 :: Text
-> SrcSpan
-> IdentifierSet
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genHDL          = Text
-> SrcSpan
-> IdentifierSet
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL
  mkTyPackage :: Text -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage     = Text -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage_
  hdlHWTypeKind :: HWType -> State VHDLState HWKind
hdlHWTypeKind = \case
    Vector {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    RTree {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    Product {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType

    Clock {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Reset {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Enable {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Index {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    CustomSP {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    SP {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    Sum {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    CustomSum {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType
    CustomProduct {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
SynonymType

    BitVector Int
_ -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
Bool -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
Bit -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    Unsigned {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    Signed {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
String -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
Integer -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    HWType
FileType -> HWKind -> State VHDLState HWKind
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']
_ 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 (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
    KnownDomain {} -> HWKind -> State VHDLState HWKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType

  hdlType :: Usage -> HWType -> Mon (State VHDLState) Doc
hdlType Usage
Internal      (HWType -> HWType
filterTransparent -> HWType
ty) = HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
ty
  hdlType (External Text
nm) (HWType -> HWType
filterTransparent -> HWType
ty) =
    let sized :: Mon (State VHDLState) Doc
sized = HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
ty in
    case HWType
ty of
      HWType
Bit         -> Mon (State VHDLState) Doc
sized
      HWType
Bool        -> Mon (State VHDLState) Doc
sized
      Signed Int
_    -> Mon (State VHDLState) Doc
sized
      Unsigned Int
_  -> Mon (State VHDLState) Doc
sized
      BitVector Int
_ -> Mon (State VHDLState) Doc
sized
      HWType
_           -> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
sized
  hdlTypeErrValue :: HWType -> Mon (State VHDLState) Doc
hdlTypeErrValue = HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue
  hdlTypeMark :: HWType -> Mon (State VHDLState) Doc
hdlTypeMark     = HWType -> Mon (State VHDLState) Doc
qualTyName
  hdlRecSel :: HWType -> Int -> Mon (State VHDLState) Doc
hdlRecSel       = HWType -> Int -> Mon (State VHDLState) Doc
vhdlRecSel
  hdlSig :: Text -> HWType -> Mon (State VHDLState) Doc
hdlSig Text
t HWType
ty     = Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
sigDecl (Text -> Mon (State VHDLState) 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 -> Mon (State VHDLState) (Maybe Doc)
inst            = Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_
  expr :: Bool -> Expr -> Mon (State VHDLState) Doc
expr            = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
toBV HWType
t Text
id_
    | HWType -> Bool
isBV HWType
t = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_
    | Bool
otherwise = do
      Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 :: Mon (State VHDLState) Doc
e = HWType -> Mon (State VHDLState) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeMark HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
      Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
e
  fromBV :: HWType -> Text -> Mon (State VHDLState) Doc
fromBV HWType
t Text
id_
    | HWType -> Bool
isBV HWType
t = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_
    | Bool
otherwise = do
      Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Mon (State VHDLState) 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 :: Text
_modNm = Text
nm}
  setSrcSpan :: SrcSpan -> State VHDLState ()
setSrcSpan      = ((SrcSpan -> Identity SrcSpan) -> VHDLState -> Identity VHDLState
Lens' VHDLState SrcSpan
srcSpan ((SrcSpan -> Identity SrcSpan) -> VHDLState -> Identity VHDLState)
-> SrcSpan -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
  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] -> Mon (State VHDLState) Doc
blockDecl Identifier
nm [Declaration]
ds = do
    Doc
decs <- [Declaration] -> Mon (State VHDLState) Doc
decls [Declaration]
ds
    let attrs :: [(Identifier, Attr')]
attrs = [ (Identifier
id_, Attr'
attr)
                | NetDecl' Maybe Text
_ WireOrReg
_ Identifier
id_ (Right HWType
hwtype) Maybe Expr
_ <- [Declaration]
ds
                , Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
    if Doc -> Bool
isEmpty Doc
decs
       then [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
       else Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
              (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"block" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
               Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
               if [(Identifier, Attr')] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr')]
attrs
                then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                else Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs (String -> Text
TextS.pack String
"signal") [(Identifier, Attr')]
attrs) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
              (Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
                [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
            Mon (State VHDLState) Doc
"end block" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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[(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. [a] -> [a] -> [a]
++)
  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 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
  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 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
  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 (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(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
  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_

type VHDLM a = Mon (State VHDLState) a

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

-- | Generate unique (partial) names for product fields. Example:
--
-- >>> productFieldNames [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 :: 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)
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 -> Mon (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 -> Mon (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
      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
g:[Text]
gs) -> (Text
g, Int -> Int
forall a. Enum a => a -> a
succ ([Text] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Text]
gs))) [[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) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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 (m :: Type -> Type) a. Monad m => a -> m a
return [Text]
names
 where
  hName
    :: Maybe IdentifierText
    -> HWType
    -> VHDLM IdentifierText
  hName :: Maybe Text -> HWType -> Mon (State VHDLState) Text
hName Maybe Text
Nothing HWType
field = HasCallStack => Bool -> HWType -> Mon (State VHDLState) Text
Bool -> HWType -> Mon (State VHDLState) Text
tyName' Bool
False HWType
field
  hName (Just Text
label) HWType
_field = Identifier -> Text
Id.toText (Identifier -> Text)
-> Mon (State VHDLState) Identifier -> Mon (State VHDLState) Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Mon (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. TextShow 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 :: Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) 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)
      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 -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty ([Text]
names [Text] -> Int -> Text
forall a. [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 :: Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Text]
fieldLabels [HWType]
fieldTypes Int
fieldIndex =
  Mon (State VHDLState) Doc
"_sel" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fieldIndex Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
productFieldName Maybe [Text]
fieldLabels [HWType]
fieldTypes Int
fieldIndex

-- | Generate VHDL for a Netlist component
genVHDL
  :: ModName
  -> SrcSpan
  -> IdentifierSet
  -> Component
  -> VHDLM ((String, Doc), [(String, Doc)])
genVHDL :: Text
-> SrcSpan
-> IdentifierSet
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL Text
nm SrcSpan
sp IdentifierSet
seen 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 () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ (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

    State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> State VHDLState ()
forall state. Backend state => SrcSpan -> State state ()
setSrcSpan SrcSpan
sp
    Doc
v <- Mon (State VHDLState) Doc
vhdl
    [(String, Doc)]
i <- State VHDLState [(String, Doc)]
-> Mon (State VHDLState) [(String, Doc)]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState [(String, Doc)]
 -> Mon (State VHDLState) [(String, Doc)])
-> State VHDLState [(String, Doc)]
-> Mon (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 () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (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 () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (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)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
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 :: Mon (State VHDLState) Doc
vhdl    = do
      Doc
ent  <- Component -> Mon (State VHDLState) Doc
entity Component
c
      Doc
arch <- Component -> Mon (State VHDLState) Doc
architecture Component
c
      Doc
imps <- Text -> Mon (State VHDLState) Doc
tyImports Text
nm
      (Mon (State VHDLState) Doc
"-- Automatically generated VHDL-93" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
       Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
imps Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
       Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
ent Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
       Doc -> Mon (State VHDLState) Doc
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] -> Mon (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
    { HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    ; 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 :: Mon (State VHDLState) Doc
packageDec  = Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (HWType -> Mon (State VHDLState) Doc)
-> [HWType] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec ((HWType -> HWType -> Bool) -> [HWType] -> [HWType]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy HWType -> HWType -> Bool
eqTypM [HWType]
sortedTys0)
          ([Mon (State VHDLState) Doc]
funDecs,[Mon (State VHDLState) Doc]
funBodies) = [(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)]
 -> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc]))
-> ([HWType]
    -> [(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)])
-> [HWType]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWType
 -> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc))
-> [HWType]
-> [(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HdlSyn
-> HWType
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
funDec HdlSyn
syn) ([HWType]
 -> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc]))
-> [HWType]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) 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 ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
normaliseType [HWType]
sortedTys0)

    ; ((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)])
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Mon (State VHDLState) Doc
"library IEEE;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc
"use IEEE.STD_LOGIC_1164.ALL;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc
"use IEEE.NUMERIC_STD.ALL;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc
"package" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text
modName Text -> Text -> Text
`TextS.append` Text
"_types") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
         Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ( Mon (State VHDLState) Doc
packageDec Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
                    Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc]
funDecs)
                  ) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Mon (State VHDLState) Doc] -> Mon (State VHDLState) Doc
packageBodyDec [Mon (State VHDLState) Doc]
funBodies
    }
  where
    packageBodyDec :: [VHDLM Doc] -> VHDLM Doc
    packageBodyDec :: [Mon (State VHDLState) Doc] -> Mon (State VHDLState) Doc
packageBodyDec [Mon (State VHDLState) Doc]
funBodies = case [Mon (State VHDLState) Doc]
funBodies of
      [] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      [Mon (State VHDLState) Doc]
_  -> do
        { Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
         Mon (State VHDLState) Doc
"package" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"body" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text
modName Text -> Text -> Text
`TextS.append` Text
"_types") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
           Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc]
funBodies)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
         Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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']
_ HWType
elTy     -> HWType -> [HWType]
mkUsedTys HWType
elTy
  CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ [(FieldAnn, HWType)]
tys0 ->
    (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((FieldAnn, HWType) -> HWType) -> [(FieldAnn, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd [(FieldAnn, 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 :: [(Int, HWType)]
nodes  = [Int] -> [HWType] -> [(Int, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [HWType]
hwtys
    nodesI :: HashMap HWType Int
nodesI = [(HWType, Int)] -> HashMap HWType Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([HWType] -> [Int] -> [(HWType, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
hwtys [Int
0..])
    edges :: [(Int, Int)]
edges  = (HWType -> [(Int, Int)]) -> [HWType] -> [(Int, Int)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [(Int, Int)]
edge [HWType]
hwtys

    sorted :: [HWType]
sorted =
      case [(Int, HWType)] -> [(Int, Int)] -> Either String [HWType]
forall a. [(Int, a)] -> [(Int, Int)] -> Either String [a]
reverseTopSort [(Int, HWType)]
nodes [(Int, Int)]
edges of
        Left String
err -> String -> [HWType]
forall a. HasCallStack => String -> a
error (String -> [HWType]) -> String -> [HWType]
forall a b. (a -> b) -> a -> b
$ $(String
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 -> [(Int, Int)]
edge t :: HWType
t@(Vector Int
_ HWType
elTy) =
      case HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
elTy) HashMap HWType Int
nodesI of
        Just Int
node ->
          [(HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t, Int
node)]
        Maybe Int
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 Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
vecZ HashMap HWType Int
nodesI of
        Just Int
node ->
          [(HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t, Int
node)] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ HWType -> [(Int, Int)]
edge HWType
elTy
        Maybe Int
Nothing ->
          []

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

    edge t :: HWType
t@(CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ (((FieldAnn, HWType) -> HWType) -> [(FieldAnn, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd -> [HWType]
tys0)) =
      let tys1 :: [Maybe Int]
tys1 = [HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Int
nodesI | HWType
ty <- [HWType]
tys0] in
      (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
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 :: HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty =
  Mon (State VHDLState) Doc
"subtype" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
            Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is"
            Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedTyName (HWType -> HWType
normaliseType HWType
hwty)
            Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

tyDec :: HasCallStack => HWType -> VHDLM Doc
tyDec :: HWType -> Mon (State VHDLState) Doc
tyDec HWType
hwty = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HWType
hwty of
    -- "Proper" custom types:
    Vector Int
_ HWType
elTy ->
      case HdlSyn
syn of
        HdlSyn
Vivado ->
          Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is array (integer range <>) of std_logic_vector"
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

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

    RTree Int
_ HWType
elTy ->
      case HdlSyn
syn of
        HdlSyn
Vivado ->
          Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is array (integer range <>) of"
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector"
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
                 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

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

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

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

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

    -- Transparent types:
    BiDirectional PortDirection
_ HWType
ty -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec HWType
ty
    Annotated [Attr']
_ HWType
ty -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec HWType
ty

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

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




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

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

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

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

  )

funDec HdlSyn
_ t :: HWType
t@(Product Text
_ Maybe [Text]
labels [HWType]
elTys) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
  ( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"p :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  , Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"p :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " Mon (State VHDLState) [Doc]
elTyToSLV)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
"," Mon (State VHDLState) [Doc]
elTyFromSLV)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  )
  where
    elTyToSLV :: Mon (State VHDLState) [Doc]
elTyToSLV = [Int]
-> (Int -> Mon (State VHDLState) Doc)
-> Mon (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 (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 -> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
                            Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"p." Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) Doc
tyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) 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
    starts :: [Int]
starts     = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int, [Int]) -> [Int]
forall a b. (a, b) -> b
snd ((Int -> Int -> (Int, Int)) -> Int -> [Int] -> (Int, [Int])
forall (t :: Type -> Type) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((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)
    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] -> [Int]
forall a. [a] -> [a]
tail [Int]
starts)

    elTyFromSLV :: Mon (State VHDLState) [Doc]
elTyFromSLV = [(Int, Int)]
-> ((Int, Int) -> Mon (State VHDLState) Doc)
-> Mon (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) -> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
                          Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"islv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)))

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

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

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

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

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

funDec HdlSyn
_ HWType
_ = Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. Maybe a
Nothing

tyImports :: ModName -> VHDLM Doc
tyImports :: Text -> Mon (State VHDLState) Doc
tyImports Text
nm = do
  [Text]
libs <- State VHDLState [Text] -> Mon (State VHDLState) [Text]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState [Text] -> Mon (State VHDLState) [Text])
-> State VHDLState [Text] -> Mon (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] -> Mon (State VHDLState) [Text]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState [Text] -> Mon (State VHDLState) [Text])
-> State VHDLState [Text] -> Mon (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
  Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (m :: Type -> Type).
Monad m =>
Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
    ([ Mon (State VHDLState) Doc
"library IEEE"
     , Mon (State VHDLState) Doc
"use IEEE.STD_LOGIC_1164.ALL"
     , Mon (State VHDLState) Doc
"use IEEE.NUMERIC_STD.ALL"
     , Mon (State VHDLState) Doc
"use IEEE.MATH_REAL.ALL"
     , Mon (State VHDLState) Doc
"use std.textio.all"
     , Mon (State VHDLState) Doc
"use work.all"
     , Mon (State VHDLState) Doc
"use work." Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text
nm Text -> Text -> Text
`TextS.append` Text
"_types") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
".all"
     ] [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. [a] -> [a] -> [a]
++ ((Text -> Mon (State VHDLState) Doc)
-> [Text] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Mon (State VHDLState) Doc
"library" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>) (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Text -> Mon (State VHDLState) Doc)
-> Text
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mon (State VHDLState) 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))
       [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. [a] -> [a] -> [a]
++ ((Text -> Mon (State VHDLState) Doc)
-> [Text] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Mon (State VHDLState) Doc
"use" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>) (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Text -> Mon (State VHDLState) Doc)
-> Text
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mon (State VHDLState) 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 :: Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port (Identifier -> Text
Id.toText -> Text
elName) HWType
hwType Mon (State VHDLState) 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)) -> Mon (State VHDLState) Doc -> VHDLM (Doc, t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (HWType -> Mon (State VHDLState) Doc
encodingNote HWType
hwType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill Int
fillToN (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
elName) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
direction
   Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
hwType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
iE)
 where
  direction :: Mon (State VHDLState) Doc
direction | HWType -> Bool
isBiSignalIn HWType
hwType = Mon (State VHDLState) Doc
"inout"
            | Bool
otherwise           = Mon (State VHDLState) Doc
portDirection

  iE :: Mon (State VHDLState) Doc
iE = Mon (State VHDLState) Doc
-> (Expr -> Mon (State VHDLState) Doc)
-> Maybe Expr
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
noEmptyInit (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Expr -> Mon (State VHDLState) Doc)
-> Expr
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
entity Component
c = do
    HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
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 -> Mon (State VHDLState) [(Doc, Int)]
ports ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls))
    Mon (State VHDLState) Doc
"entity" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      (case [Doc]
p of
         [] -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
[Doc] -> f Doc
rports [Doc]
p Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> if [(Identifier, Attr')] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr')]
attrs then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else
                              Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
rattrs) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
          HdlSyn
_     -> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
[Doc] -> f Doc
rports [Doc]
p) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      )
  where
    ports :: Int -> Mon (State VHDLState) [(Doc, Int)]
ports Int
l = [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Mon (State VHDLState) (Doc, Int)]
 -> Mon (State VHDLState) [(Doc, Int)])
-> [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall a b. (a -> b) -> a -> b
$ [Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> Mon (State VHDLState) (Doc, Int)
forall t.
Num t =>
Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port Identifier
iName HWType
hwType Mon (State VHDLState) Doc
"in" Int
l Maybe Expr
forall a. Maybe a
Nothing | (Identifier
iName, HWType
hwType) <- Component -> [(Identifier, HWType)]
inputs Component
c]
                      [Mon (State VHDLState) (Doc, Int)]
-> [Mon (State VHDLState) (Doc, Int)]
-> [Mon (State VHDLState) (Doc, Int)]
forall a. [a] -> [a] -> [a]
++ [Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> Mon (State VHDLState) (Doc, Int)
forall t.
Num t =>
Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port Identifier
oName HWType
hwType Mon (State VHDLState) Doc
"out" Int
l Maybe Expr
iEM | (WireOrReg
_, (Identifier
oName, HWType
hwType), Maybe Expr
iEM) <- Component -> [(WireOrReg, (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 (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 :: Mon (State VHDLState) Doc
rattrs      = Text -> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs (String -> Text
TextS.pack String
"signal") [(Identifier, Attr')]
attrs
    attrs :: [(Identifier, Attr')]
attrs       = [(Identifier, Attr')]
inputAttrs [(Identifier, Attr')]
-> [(Identifier, Attr')] -> [(Identifier, Attr')]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr')]
outputAttrs
    inputAttrs :: [(Identifier, Attr')]
inputAttrs  = [(Identifier
id_, Attr'
attr) | (Identifier
id_, HWType
hwtype) <- Component -> [(Identifier, HWType)]
inputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
    outputAttrs :: [(Identifier, Attr')]
outputAttrs = [(Identifier
id_, Attr'
attr) | (WireOrReg
_wireOrReg, (Identifier
id_, HWType
hwtype), Maybe Expr
_) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]


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

   isNetDecl :: Declaration -> Bool
   isNetDecl :: Declaration -> Bool
isNetDecl (NetDecl' Maybe Text
_ WireOrReg
_ Identifier
_ (Right HWType
_) Maybe Expr
_) = Bool
True
   isNetDecl Declaration
_                            = Bool
False

attrType
  :: t ~ HashMap T.Text T.Text
  => t
  -> Attr'
  -> t
attrType :: t -> Attr' -> t
attrType t
types Attr'
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' t
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' t
HashMap Text Text
types
    Just Text
type'' | Text
type'' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
type' -> t
types
                | Bool
otherwise -> String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$
                      $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ Text -> String
T.unpack Text
name', String
"already assigned"
                                           , Text -> String
T.unpack Text
type'', String
"while we tried to"
                                           , String
"add", Text -> String
T.unpack Text
type' ]
 where
  name' :: Text
name' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Attr' -> String
attrName Attr'
attr
  type' :: Text
type' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ case Attr'
attr of
            BoolAttr' String
_ Bool
_    -> String
"boolean"
            IntegerAttr' String
_ FieldAnn
_ -> String
"integer"
            StringAttr' String
_ String
_  -> String
"string"
            Attr' String
_          -> String
"bool"

-- | Create 'attrname -> type' mapping for given attributes. Will err if multiple
-- types are assigned to the same name.
attrTypes :: [Attr'] -> HashMap T.Text T.Text
attrTypes :: [Attr'] -> HashMap Text Text
attrTypes = (HashMap Text Text -> Attr' -> HashMap Text Text)
-> HashMap Text Text -> [Attr'] -> HashMap Text Text
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashMap Text Text -> Attr' -> HashMap Text Text
forall t. (t ~ HashMap Text Text) => t -> Attr' -> t
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 T.Text (T.Text, [(TextS.Text, T.Text)])
  => [(Identifier, Attr')]
  -> t
attrMap :: [(Identifier, Attr')] -> t
attrMap [(Identifier, Attr')]
attrs0 = (t -> (Text, Attr') -> t) -> t -> [(Text, Attr')] -> t
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl t -> (Text, Attr') -> t
go t
HashMap Text (Text, [(Text, Text)])
empty' [(Text, Attr')]
attrs1
 where
  attrs1 :: [(Text, Attr')]
attrs1 = ((Identifier, Attr') -> (Text, Attr'))
-> [(Identifier, Attr')] -> [(Text, Attr')]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Text) -> (Identifier, Attr') -> (Text, Attr')
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Identifier -> Text
Id.toText) [(Identifier, Attr')]
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'] -> HashMap Text Text
attrTypes (((Text, Attr') -> Attr') -> [(Text, Attr')] -> [Attr']
forall a b. (a -> b) -> [a] -> [b]
map (Text, Attr') -> Attr'
forall a b. (a, b) -> b
snd [(Text, Attr')]
attrs1)

  go :: t -> (TextS.Text, Attr') -> t
  go :: t -> (Text, Attr') -> t
go t
map' (Text, Attr')
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)])
go' (Text, Attr')
attr)
                   (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Attr' -> String
attrName (Attr' -> String) -> Attr' -> String
forall a b. (a -> b) -> a -> b
$ (Text, Attr') -> Attr'
forall a b. (a, b) -> b
snd (Text, Attr')
attr)
                   t
HashMap Text (Text, [(Text, Text)])
map'

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

renderAttrs
  :: TextS.Text
  -> [(Identifier, Attr')]
  -> VHDLM Doc
renderAttrs :: Text -> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs Text
what ([(Identifier, Attr')] -> HashMap Text (Text, [(Text, Text)])
forall t.
(t ~ HashMap Text (Text, [(Text, Text)])) =>
[(Identifier, Attr')] -> t
attrMap -> HashMap Text (Text, [(Text, Text)])
attrs) =
  Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc])
-> [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. a -> [a] -> [a]
intersperse Mon (State VHDLState) Doc
" " ([Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc])
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> a -> b
$ ((Text, (Text, [(Text, Text)])) -> Mon (State VHDLState) Doc)
-> [(Text, (Text, [(Text, Text)]))] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, [(Text, Text)])) -> Mon (State VHDLState) 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
    :: (T.Text, (T.Text, [(TextS.Text, T.Text)]))
    -> VHDLM Doc
  renderAttrGroup :: (Text, (Text, [(Text, Text)])) -> Mon (State VHDLState) Doc
renderAttrGroup (Text
attrname, (Text
typ, [(Text, Text)]
elems)) =
    (Mon (State VHDLState) Doc
"attribute" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
attrname Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
typ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
    Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc])
-> [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Mon (State VHDLState) Doc)
-> [(Text, Text)] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> (Text, Text) -> Mon (State VHDLState) Doc
renderAttrDecl Text
attrname) [(Text, Text)]
elems)

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

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

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

-- | Append size information to given type string
appendSize :: VHDLM Doc -> HWType -> VHDLM Doc
appendSize :: Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
appendSize Mon (State VHDLState) Doc
baseType HWType
sizedType = case HWType
sizedType of
  BitVector Int
n -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
  Signed Int
n    -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
  Unsigned Int
n  -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
  Vector Int
n HWType
_  -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"0 to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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
_   -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"0 to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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))
  Annotated [Attr']
_ HWType
elTy -> Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
appendSize Mon (State VHDLState) Doc
baseType HWType
elTy
  HWType
_           -> Mon (State VHDLState) Doc
baseType

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

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

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

  -- Transparent types:
  BiDirectional PortDirection
_ HWType
elTy -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy
  Annotated [Attr']
_ HWType
elTy -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy

  -- Custom types:
  HWType
_ -> do
    Text
modName <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
modName Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types." Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
tyName HWType
t = do
  Text
nm <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Text
Bool -> HWType -> Mon (State VHDLState) Text
tyName' Bool
False HWType
t
  Text -> Mon (State VHDLState) 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' :: Bool -> HWType -> Mon (State VHDLState) Text
tyName' Bool
rec0 (HWType -> HWType
filterTransparent -> HWType
t) = do
  State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((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 -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Forced to print KnownDomain tyName"))
    Void Maybe HWType
_ ->
      Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
forall a. HasCallStack => String -> a
error ($(String
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 -> Mon (State VHDLState) Text
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. TextShow a => a -> Text
showt Int
n] else [] in
      Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Mon (State VHDLState) Text)
-> Text -> Mon (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. TextShow a => a -> Text
showt Int
n] else [] in
      Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Mon (State VHDLState) Text)
-> Text -> Mon (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. TextShow a => a -> Text
showt Int
n] else [] in
      Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Mon (State VHDLState) Text)
-> Text -> Mon (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 -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"string"
    HWType
Integer       -> Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"integer"
    HWType
Bit           -> Text -> Mon (State VHDLState) Text
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 -> Mon (State VHDLState) Text
Bool -> HWType -> Mon (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. TextShow a => a -> Text
showt Int
n Text -> Text -> Text
`TextS.append` Text
"_" else Text
""
                            , Text
elTy']
      State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> State VHDLState Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
nm)
    RTree Int
n HWType
elTy  -> do
      Text
elTy' <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Text
Bool -> HWType -> Mon (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. TextShow a => a -> Text
showt Int
n Text -> Text -> Text
`TextS.append` Text
"_" else Text
""
                            , Text
elTy']
      State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> State VHDLState Text
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 FieldAnn
n ->
      Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text
"index_" Text -> Text -> Text
`TextS.append` FieldAnn -> Text
forall a. TextShow a => a -> Text
showt FieldAnn
n)
    Clock Text
nm0 ->
      let nm1 :: Text
nm1 = Text
"clk_" Text -> Text -> Text
`TextS.append` Text
nm0 in
      State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) 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]
_ [(FieldAnn, HWType)]
_ ->
      State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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) Lens' VHDLState (HashMap (HWType, Bool) Text)
nameCache (Text -> Text -> HWType -> State VHDLState Text
userTyName Text
"product" Text
nm HWType
t)
    Annotated [Attr']
_ HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Mon (State VHDLState) Text
Bool -> HWType -> Mon (State VHDLState) Text
tyName' Bool
rec0 HWType
hwTy
    BiDirectional PortDirection
_ HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Mon (State VHDLState) Text
Bool -> HWType -> Mon (State VHDLState) Text
tyName' Bool
rec0 HWType
hwTy
    HWType
FileType -> Text -> Mon (State VHDLState) Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"file"

-- | Returns underlying type of given HWType. That is, the type by which it
-- eventually will be represented in VHDL.
normaliseType :: HWType -> HWType
normaliseType :: HWType -> HWType
normaliseType 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

  -- Simple types, for which a subtype (without qualifiers) will be made in VHDL:
  Clock Text
_           -> HWType
Bit
  Reset Text
_           -> HWType
Bit
  Enable Text
_          -> HWType
Bool
  Index FieldAnn
_           -> 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)
  Sum Text
_ [Text]
_           -> 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']
_ HWType
elTy -> HWType -> HWType
normaliseType HWType
elTy
  BiDirectional PortDirection
_ HWType
elTy -> HWType -> HWType
normaliseType 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
  Reset Text
_           -> HWType
hwty
  Enable Text
_          -> HWType
hwty
  Index FieldAnn
_           -> HWType
hwty
  Sum Text
_ [Text]
_           -> HWType
hwty
  CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_ -> HWType
hwty
  HWType
FileType          -> HWType
hwty

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

  -- Transparent types:
  Annotated [Attr']
_ HWType
elTy -> HWType
elTy
  BiDirectional PortDirection
_ HWType
elTy -> 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)
-> StateT VHDLState Identity Identifier -> State VHDLState Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> StateT VHDLState Identity Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> Text -> m Identifier
Id.makeBasicOr ([Text] -> Text
forall a. [a] -> a
last (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 -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
Bool                = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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) -> Mon (State VHDLState) Doc
"false"
    Maybe (Maybe Int)
_             -> Mon (State VHDLState) Doc
"true"
sizedQualTyNameErrValue HWType
Bit                 = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue t :: HWType
t@(Vector Int
n HWType
elTy)   = do
  HdlSyn
syn <-State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                 Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue))
    HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(RTree Int
n HWType
elTy)    = do
  HdlSyn
syn <-State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>  Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                 Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue))
    HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>  Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(Product Text
_ Maybe [Text]
_ [HWType]
elTys) =
  HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((HWType -> Mon (State VHDLState) Doc)
-> [HWType] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue [HWType]
elTys)
sizedQualTyNameErrValue (Clock Text
_)  = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Reset Text
_)  = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Enable Text
_) = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Void {})  =
  Doc -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Doc
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[CLASH BUG] Forced to print Void error value"))
sizedQualTyNameErrValue HWType
String              = Mon (State VHDLState) Doc
"\"ERROR\""
sizedQualTyNameErrValue HWType
t =
  HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) 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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue)

singularErrValue :: VHDLM Doc
singularErrValue :: Mon (State VHDLState) Doc
singularErrValue = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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       -> Mon (State VHDLState) Doc
"'-'"
    Just Maybe Int
Nothing  -> Mon (State VHDLState) Doc
"'0'"
    Just (Just Int
x) -> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'"

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

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

decl :: Int ->  Declaration -> VHDLM (Maybe (Doc,Int))
decl :: Int -> Declaration -> Mon (State VHDLState) (Maybe (Doc, Int))
decl Int
l (NetDecl' Maybe Text
noteM WireOrReg
_ Identifier
id_ Either Text 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))
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) (Maybe (Doc, Int))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Text -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Maybe Text
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. a -> a
id Text -> Mon (State VHDLState) Doc -> Mon (State VHDLState) 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 (Mon (State VHDLState) Doc
"signal" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill Int
l (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (Text -> Mon (State VHDLState) Doc)
-> (HWType -> Mon (State VHDLState) Doc)
-> Either Text HWType
-> Mon (State VHDLState) Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty HWType -> Mon (State VHDLState) Doc
sizedQualTyName Either Text HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
iE Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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 :: Mon (State VHDLState) Doc
iE = Mon (State VHDLState) Doc
-> (Expr -> Mon (State VHDLState) Doc)
-> Maybe Expr
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
noEmptyInit (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Expr -> Mon (State VHDLState) Doc)
-> Expr
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) Maybe Expr
iEM

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

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

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

decl Int
_ Declaration
_ = Maybe (Doc, Int) -> Mon (State VHDLState) (Maybe (Doc, Int))
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 :: Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
noEmptyInit Mon (State VHDLState) Doc
d = do
  Doc
d1 <- Mon (State VHDLState) Doc
d
  if Doc -> Bool
isEmpty Doc
d1
     then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
     else (Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
space Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
":=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
d)

stdMatch
  :: Bits a
  => Int
  -> a
  -> a
  -> String
stdMatch :: 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' :: Mon (State VHDLState) Doc
-> Int -> a -> a -> Mon (State VHDLState) Doc
patLitCustom' Mon (State VHDLState) Doc
var Int
size a
mask a
value =
  let mask' :: Mon (State VHDLState) Doc
mask' = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon (State VHDLState) Doc)
-> Text -> Mon (State VHDLState) 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
  Mon (State VHDLState) Doc
"std_match" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes Mon (State VHDLState) Doc
mask' Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
var)

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

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

patLitCustom Mon (State VHDLState) Doc
_ HWType
x Literal
y = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
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] -> Mon (State VHDLState) Doc
insts [] = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl Text
id_:[Declaration]
ds) = Text -> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> Text -> f Doc
comment Text
"--" Text
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
insts (Declaration
d:[Declaration]
ds) = do
  Maybe Doc
d' <- Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
d' of
    Just Doc
doc -> Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
    Maybe Doc
_ -> [Declaration] -> Mon (State VHDLState) 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)]
-> Mon (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es = (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
esNub) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
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 :: Mon (State VHDLState) Doc
var   = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True Expr
scrut

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

-- | Turn a Netlist Declaration to a VHDL concurrent block
inst_ :: Declaration -> VHDLM (Maybe Doc)
inst_ :: Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_ (Assignment Identifier
id_ Expr
e) = (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow
           Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vsep ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                                      HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
scrut Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"else"
                                     ,HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
f Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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)]
-> Mon (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)]
-> Mon (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]
_ [(FieldAnn, HWType)]
_) [(Maybe Literal, Expr)]
es) =
  Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Mon (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)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
    Mon (State VHDLState) Doc
"with" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True Expr
scrut) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"select" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma ([(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
esNub)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) 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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
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)] -> Mon (State VHDLState) [Doc]
conds []                = [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds [(Maybe Literal
_,Expr
e)]           = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"others" Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_)   = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"others" Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Literal -> Mon (State VHDLState) Doc
patLit HWType
scrutTy Literal
c Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
es'

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

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

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

inst_ (BlackBoxD Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx) =
  (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT VHDLState Identity (Int -> Doc) -> State VHDLState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (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_ Declaration
_ = Maybe Doc -> Mon (State VHDLState) (Maybe Doc)
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)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
constrRepr [(HWType, Expr)]
args =
  Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ (BitOrigin -> Mon (State VHDLState) Doc)
-> [BitOrigin] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BitOrigin -> Mon (State VHDLState) Doc
range [BitOrigin]
origins)
    where
      DataRepr' Type'
_typ Int
size [ConstrRepr']
_constrs = DataRepr'
dataRepr

      -- Build bit representations for all constructor arguments
      argSLVs :: [Mon (State VHDLState) Doc]
argSLVs = ((HWType, Expr) -> Mon (State VHDLState) Doc)
-> [(HWType, Expr)] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> (HWType, Expr) -> Mon (State VHDLState) Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
range (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
        Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (Bit -> Mon (State VHDLState) Doc)
-> [Bit] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Bit -> Mon (State VHDLState) 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' :: Mon (State VHDLState) Doc
expr' = [Mon (State VHDLState) Doc]
argSLVs [Mon (State VHDLState) Doc] -> Int -> Mon (State VHDLState) Doc
forall a. [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 :: Mon (State VHDLState) Doc
unsigned = Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) 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
               Mon (State VHDLState) 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 :: Mon (State VHDLState) Doc
resized = Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
unsigned Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize) in
               Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
resized
           | Bool
otherwise ->
               -- Select bits 'start' downto and including 'end'
               let rotated :: Mon (State VHDLState) Doc
rotated  = Mon (State VHDLState) Doc
unsigned Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"srl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end in
               let resized :: Mon (State VHDLState) Doc
resized = Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
rotated Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize) in
               Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
resized

-- | Turn a Netlist expression into a VHDL expression
expr_
  :: HasCallStack
  => Bool
  -- ^ Enclose in parentheses?
  -> Expr
  -- ^ Expr to convert
  -> VHDLM Doc
expr_ :: Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
_ (Literal Maybe (HWType, Int)
sizeM Literal
lit) = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
sizeM Literal
lit
expr_ Bool
_ (Identifier Identifier
id_ Maybe Modifier
Nothing) = Identifier -> Mon (State VHDLState) 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 -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  Mon (State VHDLState) Doc
-> ([(VHDLModifier, HWType)] -> Mon (State VHDLState) Doc)
-> Maybe [(VHDLModifier, HWType)]
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) (((VHDLModifier, HWType)
 -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc
-> [(VHDLModifier, HWType)]
-> Mon (State VHDLState) Doc
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (VHDLModifier, HWType)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
renderModifier (Identifier -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
b Expr
e

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

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

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

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

expr_ Bool
_ (DataCon ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = Mon (State VHDLState) 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. [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 (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 :: Mon (State VHDLState) Doc
dcExpr     = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
    argExprs :: [Mon (State VHDLState) Doc]
argExprs   = (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> [Mon (State VHDLState) Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType]
argTys [Expr]
es)
    extraArg :: [Mon (State VHDLState) 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] -> Mon (State VHDLState) Doc
bits (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
    assignExpr :: Mon (State VHDLState) Doc
assignExpr = Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Mon (State VHDLState) Doc
dcExprMon (State VHDLState) Doc
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. a -> [a] -> [a]
:[Mon (State VHDLState) Doc]
argExprs [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. [a] -> [a] -> [a]
++ [Mon (State VHDLState) Doc]
extraArg))

expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum Text
_ [Text]
_) (DC (HWType
_,Int
i)) []) =
  HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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
_ FieldAnn
_ FieldAnn
value [FieldAnn]
_) = (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. [a] -> Int -> a
!! Int
i in
  Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldAnn
value) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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. [a] -> Int -> a
!! Int
i in
  DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) 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 [(FieldAnn, HWType)]
tys) Modifier
_ [Expr]
es) |
  DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipEqual (((FieldAnn, HWType) -> HWType) -> [(FieldAnn, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd [(FieldAnn, HWType)]
tys) [Expr]
es)

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

expr_ Bool
_ (DataCon (Enable Text
_) Modifier
_ [Expr
e]) =
  HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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 FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
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 FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
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 FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = let NumLit FieldAnn
m' = Literal
m
        NumLit FieldAnn
i' = Literal
i
    in Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) (FieldAnn -> FieldAnn -> Literal
BitVecLit FieldAnn
m' FieldAnn
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
  = let NumLit FieldAnn
m' = Literal
m
        NumLit FieldAnn
i' = Literal
i
    in Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) 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
$ FieldAnn -> FieldAnn -> Bit
toBit FieldAnn
m' FieldAnn
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 FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , Just Int
k <- FieldAnn -> FieldAnn -> Maybe Int
clogBase FieldAnn
2 FieldAnn
n
  , let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
  = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
k',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 FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , FieldAnn
n FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
> FieldAnn
0
  , Just Int
k <- FieldAnn -> FieldAnn -> Maybe Int
clogBase FieldAnn
2 FieldAnn
n
  , let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
  = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
k',Int
k')) (FieldAnn -> Literal
NumLit (FieldAnn
nFieldAnn -> FieldAnn -> FieldAnn
forall a. Num a => a -> a -> a
-FieldAnn
1))

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
"GHC.Types.I#"
  , [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = do Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
       Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed Int
iw,Int
iw)) (FieldAnn -> Literal
NumLit FieldAnn
n)

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
"GHC.Types.W#"
  , [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = do Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
       Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
iw,Int
iw)) (FieldAnn -> Literal
NumLit FieldAnn
n)

expr_ Bool
b (BlackBoxE Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx Bool
b') = do
  Bool -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (m :: Type -> Type).
Monad m =>
Bool -> Mon m Doc -> Mon m Doc
parenIf (Bool
b Bool -> Bool -> Bool
|| Bool
b') (State VHDLState Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (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 StateT VHDLState Identity (Int -> Doc)
-> State VHDLState Int -> State VHDLState Doc
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> State VHDLState Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0))

expr_ Bool
_ (DataTag HWType
Bool (Left Identifier
id_)) = Mon (State VHDLState) Doc
"tagToEnum" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)
expr_ Bool
_ (DataTag HWType
Bool (Right Identifier
id_)) = Mon (State VHDLState) Doc
"dataToTag" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) 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_)) =
  Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
hty)))
expr_ Bool
_ (DataTag (Sum Text
_ [Text]
_) (Right Identifier
id_)) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
  Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
  Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
    ; Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (
      Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
                          Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
  Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
  Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
  Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (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
  Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
               Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> Mon (State VHDLState) Doc
qualTyName HWType
hwty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e))
    Just Identifier
t  -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)

expr_ Bool
_ (FromBv Maybe Identifier
topM HWType
_ Expr
e) = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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
  Mon (State VHDLState) Doc
-> (Identifier -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types" ) (\Identifier
t -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types") Maybe Identifier
topM Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
    Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)

expr_ Bool
_ Expr
e = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
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 (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 -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
Nothing (NumLit FieldAnn
i) = FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i

exprLit (Just (HWType
hty,Int
sz)) (NumLit FieldAnn
i) = case HWType
hty of
  Unsigned Int
n
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< (-FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer)) -> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"signed'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit))
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
0                    -> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens(FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)))
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer) -> Mon (State VHDLState) Doc
"to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
    | Bool
otherwise -> Mon (State VHDLState) Doc
"unsigned'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
  Signed Int
n
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer) Bool -> Bool -> Bool
&& FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
> (-FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer)) -> Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
    | Bool
otherwise -> Mon (State VHDLState) Doc
"signed'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
  BitVector Int
_ -> Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
  HWType
Bit         -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2))
  HWType
_           -> Mon (State VHDLState) 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 :: Mon (State VHDLState) Doc
lit = if Bool
validHexLit then Mon (State VHDLState) Doc
hlit else Mon (State VHDLState) Doc
blit
    blit :: Mon (State VHDLState) Doc
blit = [Bit] -> Mon (State VHDLState) Doc
bits (Int -> FieldAnn -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz FieldAnn
i)
    i' :: FieldAnn
i'   = case HWType
hty of
             Signed Int
_ -> let mask :: FieldAnn
mask = FieldAnn
2FieldAnn -> Int -> FieldAnn
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 FieldAnn -> FieldAnn -> (FieldAnn, FieldAnn)
forall a. Integral a => a -> a -> (a, a)
divMod FieldAnn
i FieldAnn
mask of
                (FieldAnn
s,FieldAnn
i'') | FieldAnn -> Bool
forall a. Integral a => a -> Bool
even FieldAnn
s    -> FieldAnn
i''
                        | Bool
otherwise -> FieldAnn
i'' FieldAnn -> FieldAnn -> FieldAnn
forall a. Num a => a -> a -> a
- FieldAnn
mask
             HWType
_ -> FieldAnn
i FieldAnn -> FieldAnn -> FieldAnn
forall a. Integral a => a -> a -> a
`mod` FieldAnn
2FieldAnn -> Int -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz
    hlit :: Mon (State VHDLState) Doc
hlit = (if FieldAnn
i' FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
0 then Mon (State VHDLState) Doc
"-" else Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> String -> Mon (State VHDLState) Doc
hex (Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i')

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


exprLit Maybe (HWType, Int)
_             (BoolLit Bool
t)   = if Bool
t then Mon (State VHDLState) Doc
"true" else Mon (State VHDLState) Doc
"false"
exprLit Maybe (HWType, Int)
_             (BitLit Bit
b)    = Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Bit -> Mon (State VHDLState) Doc
bit_char Bit
b
exprLit Maybe (HWType, Int)
_             (StringLit String
s) = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Mon (State VHDLState) Doc)
-> (String -> Text) -> String -> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
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 -> Mon (State VHDLState) Doc
patLit HWType
Bit (NumLit FieldAnn
i) = if FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
0 then Mon (State VHDLState) Doc
"'0'" else Mon (State VHDLState) Doc
"'1'"
patLit HWType
hwTy (NumLit FieldAnn
i) =
  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 -> Mon (State VHDLState) Doc
hex  (Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i)
        Int
_ -> [Bit] -> Mon (State VHDLState) Doc
bits (Int -> FieldAnn -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz FieldAnn
i)
patLit HWType
_    Literal
l          = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
l

patMod :: HWType -> Literal -> Literal
patMod :: HWType -> Literal -> Literal
patMod HWType
hwTy (NumLit FieldAnn
i) = FieldAnn -> Literal
NumLit (FieldAnn
i FieldAnn -> FieldAnn -> FieldAnn
forall a. Integral a => a -> a -> a
`mod` (FieldAnn
2 FieldAnn -> Int -> FieldAnn
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 :: 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' :: 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] -> Mon (State VHDLState) Doc
bits = Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> ([Bit] -> Mon (State VHDLState) Doc)
-> [Bit]
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> ([Bit] -> Mon (State VHDLState) [Doc])
-> [Bit]
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Mon (State VHDLState) Doc)
-> [Bit] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Bit -> Mon (State VHDLState) Doc
bit_char

toHex :: Int -> Integer -> String
toHex :: Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i =
  let Just Int
d = FieldAnn -> FieldAnn -> Maybe Int
clogBase FieldAnn
16 (FieldAnn
2FieldAnn -> Int -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz)
  in  String -> FieldAnn -> 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") (FieldAnn -> FieldAnn
forall a. Num a => a -> a
abs FieldAnn
i)

hex :: String -> VHDLM Doc
hex :: String -> Mon (State VHDLState) Doc
hex String
s = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'x' Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Text -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
bit_char Bit
H = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'1'
bit_char Bit
L = Char -> Mon (State VHDLState) 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))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'-'
    Just Maybe Int
Nothing -> Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'0'
    Just (Just Int
i) -> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'"
bit_char Bit
Z = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'Z'

toSLV :: HasCallStack => HWType -> Expr -> VHDLM Doc
toSLV :: HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
Bool         Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV HWType
Bit          Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Clock {})    Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Reset {})    Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Text
TextS.toLower Text
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Enable Text
_)    Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (BitVector Int
_) Expr
e = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True Expr
e
toSLV (Signed Int
_)   Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Unsigned Int
_) Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Index FieldAnn
_)    Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Sum Text
_ [Text]
_)    Expr
e = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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
_ FieldAnn
_ FieldAnn
value [FieldAnn]
_) = (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. [a] -> Int -> a
!! Int
i in
  let unsigned :: Mon (State VHDLState) Doc
unsigned = Mon (State VHDLState) Doc
"to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldAnn
value) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
size) in
  Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
unsigned
toSLV (CustomSum {}) Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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' <- [Mon (State VHDLState) Expr] -> Mon (State VHDLState) [Expr]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Expr]
selIds
    Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc]
-> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen Mon (State VHDLState) Doc
" & " ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType]
tys [Expr]
selIds')
  where
    tName :: Mon (State VHDLState) Doc
tName    = HWType -> Mon (State VHDLState) Doc
tyName HWType
t
    selNames :: [Mon (State VHDLState) Identifier]
selNames = (Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier)
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
tName Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
i | Int
i <- [Int
0..([HWType] -> 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 :: [Mon (State VHDLState) Expr]
selIds   = (Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr)
-> [Mon (State VHDLState) Identifier]
-> [Mon (State VHDLState) Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Expr)
-> Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr
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)) [Mon (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
  Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc]
-> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen Mon (State VHDLState) Doc
" & " ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType]
tys [Expr]
es)
toSLV (CustomProduct Text
_ DataRepr'
_ Int
_ Maybe [Text]
_ [(FieldAnn, HWType)]
_) Expr
e = do
  -- Custom representations are represented as bitvectors in HDL, so we don't
  -- need to do anything.
  HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV t :: HWType
t@(Product Text
_ Maybe [Text]
_ [HWType]
_) Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e))
toSLV (SP Text
_ [(Text, [HWType])]
_) Expr
e       = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV (Vector Int
n HWType
elTy) (Identifier Identifier
id_ Maybe Modifier
Nothing) = do
    [Expr]
selIds' <- [Mon (State VHDLState) Expr] -> Mon (State VHDLState) [Expr]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Expr]
selIds
    HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & "
      (case HdlSyn
syn of
        HdlSyn
Vivado -> (Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) [Expr]
selIds'
        HdlSyn
_ -> (Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
elTy) [Expr]
selIds'))
  where
    selNames :: [Mon (State VHDLState) Identifier]
selNames = (Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier)
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
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) ) ([Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Identifier])
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Identifier]
forall a b. (a -> b) -> a -> b
$ [Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) 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 :: [Mon (State VHDLState) Expr]
selIds   = (Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr)
-> [Mon (State VHDLState) Identifier]
-> [Mon (State VHDLState) Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Expr)
-> Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr
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)) [Mon (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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Vector Int
n HWType
elTy) (DataCon HWType
_ Modifier
_ [Expr]
es) =
  Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) 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 -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Text -> Mon (State VHDLState) Text)
-> State VHDLState Text -> Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (RTree Int
_ HWType
_) Expr
e = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Text
TextS.toLower Text
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV HWType
hty Expr
e = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
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)) (FieldAnn -> Literal
NumLit (Int -> FieldAnn
forall a. Integral a => a -> FieldAnn
toInteger Int
i))

larrow :: VHDLM Doc
larrow :: Mon (State VHDLState) Doc
larrow = Mon (State VHDLState) Doc
"<="

rarrow :: VHDLM Doc
rarrow :: Mon (State VHDLState) Doc
rarrow = Mon (State VHDLState) Doc
"=>"

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

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

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

tupledSemi :: Applicative f => f [Doc] -> f Doc
tupledSemi :: 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 :: 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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Mon (State VHDLState) Doc
d = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) Doc
tyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Text] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Text]
labels [HWType]
tys Int
fI
      in  [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Mon (State VHDLState) Doc -> VHDLModifier
Select Mon (State VHDLState) 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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 FieldAnn
_mask FieldAnn
_value [FieldAnn]
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 = FieldAnn -> [(Int, Int)]
bitRanges (String -> [FieldAnn] -> Int -> FieldAnn
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid annotation index" [FieldAnn]
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]
_ [(FieldAnn, 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 FieldAnn
_mask FieldAnn
_val [FieldAnn]
fieldAnns <- ConstrRepr'
cRepr
  , let ses :: [(Int, Int)]
ses = FieldAnn -> [(Int, Int)]
bitRanges (String -> [FieldAnn] -> Int -> FieldAnn
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom product type: invalid annotation index"
                         [FieldAnn]
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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 = (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd (String -> [(FieldAnn, HWType)] -> Int -> (FieldAnn, HWType)
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom product type: invalid field index" [(FieldAnn, 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 :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
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)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
renderModifier (Idx Int
n,HWType
_) Mon (State VHDLState) Doc
doc = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
renderModifier (Slice Int
start Int
end,HWType
_) Mon (State VHDLState) Doc
doc = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
renderModifier (Select Mon (State VHDLState) Doc
sel,HWType
_) Mon (State VHDLState) Doc
doc = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
sel
-- See [Note] integer projection
renderModifier (VHDLModifier
Resize,HWType
ty) Mon (State VHDLState) Doc
doc = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 -> Mon (State VHDLState) Doc -> Mon (State VHDLState) 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) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
renderModifier (VHDLModifier
ResizeAndConvert,HWType
ty) Mon (State VHDLState) Doc
doc = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 -> Mon (State VHDLState) Doc -> Mon (State VHDLState) 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) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
-- See [Note] mask projection
renderModifier (VHDLModifier
DontCare,HWType
_) Mon (State VHDLState) Doc
_ = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf Bool
True ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: rendering bitvector mask as dontcare") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue (Int -> HWType
Unsigned Int
iw)
renderModifier (Range Range
r,HWType
t) Mon (State VHDLState) Doc
doc = do
  Text
nm <- State VHDLState Text -> Mon (State VHDLState) Text
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (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 doc1 :: Mon (State VHDLState) Doc
doc1 = case Range
r of
        Contiguous Int
start Int
end -> Int -> Int -> Mon (State VHDLState) Doc
slice Int
start Int
end
        Split [(Int, Int, Provenance)]
rs -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (((Int, Int, Provenance) -> Mon (State VHDLState) Doc)
-> [(Int, Int, Provenance)] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
s,Int
e,Provenance
_) -> Int -> Int -> Mon (State VHDLState) Doc
slice Int
s Int
e) [(Int, Int, Provenance)]
rs)))
  case HWType -> HWType
normaliseType HWType
t of
    BitVector Int
_ -> Mon (State VHDLState) Doc
doc1
    -- See [Note] Continuing from an SLV slice
    HWType
_ ->
      HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Text
TextS.toLower Text
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
doc1)
 where
  slice :: Int -> Int -> Mon (State VHDLState) Doc
slice Int
s Int
e = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)