{-|
  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 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.Hashable                        (Hashable)
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,fromMaybe,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
import qualified Data.Text.Prettyprint.Doc            as PP
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           Clash.Netlist.Id                     (IdType (..), mkBasicId')
import           Clash.Netlist.Types                  hiding (_intWidth, intWidth)
import           Clash.Netlist.Util                   hiding (mkIdentifier)
import           Clash.Util
  (SrcSpan, noSrcSpan, clogBase, curLoc, first, makeCached, on, indexNote)
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 Identifier Word
_tySeen    :: HashMap Identifier Word
  -- ^ Generated product types
  , VHDLState -> HashMap (HWType, Bool) Identifier
_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 -> Identifier
_modNm     :: Identifier
  , VHDLState -> SrcSpan
_srcSpan   :: SrcSpan
  , VHDLState -> [Text]
_libraries :: [T.Text]
  , VHDLState -> [Text]
_packages  :: [T.Text]
  , VHDLState -> [(String, Doc)]
_includes  :: [(String,Doc)]
  , VHDLState -> [(String, String)]
_dataFiles      :: [(String,FilePath)]
  -- ^ Files to be copied: (filename, old path)
  , VHDLState -> [(String, String)]
_memoryDataFiles:: [(String,String)]
  -- ^ Files to be stored: (filename, contents). These files are generated
  -- during the execution of 'genNetlist'.
  , VHDLState -> HashMap Identifier Word
_idSeen    :: HashMapS.HashMap Identifier Word
  , VHDLState -> Int
_intWidth  :: Int
  -- ^ Int/Word/Integer bit-width
  , VHDLState -> HdlSyn
_hdlsyn    :: HdlSyn
  -- ^ For which HDL synthesis tool are we generating VHDL
  , VHDLState -> Bool
_extendedIds :: Bool
  , VHDLState -> Maybe (Maybe Int)
_undefValue :: Maybe (Maybe Int)
  }

makeLenses ''VHDLState

instance Backend VHDLState where
  initBackend :: Int -> HdlSyn -> Bool -> Maybe (Maybe Int) -> VHDLState
initBackend     = HashSet HWType
-> HashMap Identifier Word
-> HashMap (HWType, Bool) Identifier
-> Identifier
-> SrcSpan
-> [Text]
-> [Text]
-> [(String, Doc)]
-> [(String, String)]
-> [(String, String)]
-> HashMap Identifier Word
-> Int
-> HdlSyn
-> Bool
-> Maybe (Maybe Int)
-> VHDLState
VHDLState HashSet HWType
forall a. HashSet a
HashSet.empty HashMap Identifier Word
forall k v. HashMap k v
HashMap.empty HashMap (HWType, Bool) Identifier
forall k v. HashMap k v
HashMap.empty Identifier
""
                              SrcSpan
noSrcSpan [] [] [] [] [] HashMap Identifier Word
forall k v. HashMap k v
HashMapS.empty
  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 :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genHDL          = Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL
  mkTyPackage :: Identifier -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage     = Identifier -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage_
  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 Identifier
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
_           -> 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
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
      Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
      HashMap Identifier Word
seen <- Getting
  (HashMap Identifier Word) VHDLState (HashMap Identifier Word)
-> Mon (State VHDLState) (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (HashMap Identifier Word) VHDLState (HashMap Identifier Word)
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
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 :: Mon (State VHDLState) Doc
e | Text -> Identifier
T.toStrict Text
id_ Identifier -> HashMap Identifier Word -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMapS.member` HashMap Identifier Word
seen = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_
            | Bool
otherwise = 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_)
      Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
      Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
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 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
  mkIdentifier :: State VHDLState (IdType -> Identifier -> Identifier)
mkIdentifier    = do
      Bool
allowExtended <- Getting Bool VHDLState Bool -> StateT VHDLState Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool VHDLState Bool
Lens' VHDLState Bool
extendedIds
      (IdType -> Identifier -> Identifier)
-> State VHDLState (IdType -> Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> IdType -> Identifier -> Identifier
go Bool
allowExtended)
    where
      go :: Bool -> IdType -> Identifier -> Identifier
go Bool
_ IdType
Basic Identifier
nm =
        case (Identifier -> Identifier
stripTrailingUnderscore (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
filterReserved) (Identifier -> Identifier
TextS.toLower (HDL -> Bool -> Identifier -> Identifier
mkBasicId' HDL
VHDL Bool
True Identifier
nm)) of
          Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> Identifier
"clash_internal"
              | Bool
otherwise -> Identifier
nm'
      go Bool
esc IdType
Extended (Identifier -> Identifier
rmSlash -> Identifier
nm) = case Bool -> IdType -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm of
        Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nm' -> [Identifier] -> Identifier
TextS.concat [Identifier
"\\",Identifier
nm,Identifier
"\\"]
            | Bool
otherwise -> Identifier
nm'
  extendIdentifier :: State VHDLState (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier = do
      Bool
allowExtended <- Getting Bool VHDLState Bool -> StateT VHDLState Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool VHDLState Bool
Lens' VHDLState Bool
extendedIds
      (IdType -> Identifier -> Identifier -> Identifier)
-> State
     VHDLState (IdType -> Identifier -> Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
allowExtended)
    where
      go :: Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
_ IdType
Basic Identifier
nm Identifier
ext =
        case (Identifier -> Identifier
stripTrailingUnderscore (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
filterReserved) (Identifier -> Identifier
TextS.toLower (HDL -> Bool -> Identifier -> Identifier
mkBasicId' HDL
VHDL Bool
True (Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext))) of
          Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> Identifier
"clash_internal"
              | Bool
otherwise -> Identifier
nm'
      go Bool
esc IdType
Extended ((Identifier -> Identifier
rmSlash (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
escapeTemplate) -> Identifier
nm) Identifier
ext =
        let nmExt :: Identifier
nmExt = Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext
        in  case Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm Identifier
ext of
              Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nmExt -> case Identifier -> Identifier -> Bool
TextS.isPrefixOf Identifier
"c$" Identifier
nmExt of
                      Bool
True -> [Identifier] -> Identifier
TextS.concat [Identifier
"\\",Identifier
nmExt,Identifier
"\\"]
                      Bool
_    -> [Identifier] -> Identifier
TextS.concat [Identifier
"\\c$",Identifier
nmExt,Identifier
"\\"]
                  | Bool
otherwise -> Identifier
nm'

  setModName :: Identifier -> VHDLState -> VHDLState
setModName Identifier
nm VHDLState
s = VHDLState
s {_modNm :: Identifier
_modNm = Identifier
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 Identifier
_ 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
<> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs [(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
  unextend :: State VHDLState (Identifier -> Identifier)
unextend = (Identifier -> Identifier)
-> State VHDLState (Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier -> Identifier
rmSlash
  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
  seenIdentifiers :: (HashMap Identifier Word -> f (HashMap Identifier Word))
-> VHDLState -> f VHDLState
seenIdentifiers = (HashMap Identifier Word -> f (HashMap Identifier Word))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap Identifier Word)
idSeen
  ifThenElseExpr :: VHDLState -> Bool
ifThenElseExpr VHDLState
_ = Bool
False

rmSlash :: Identifier -> Identifier
rmSlash :: Identifier -> Identifier
rmSlash Identifier
nm = Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
nm (Maybe Identifier -> Identifier) -> Maybe Identifier -> Identifier
forall a b. (a -> b) -> a -> b
$ do
  Identifier
nm1 <- Identifier -> Identifier -> Maybe Identifier
TextS.stripPrefix Identifier
"\\" Identifier
nm
  Identifier -> Maybe Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Char -> Bool) -> Identifier -> Identifier
TextS.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')) Identifier
nm1)

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

-- | Time units: are added to 'reservedWords' as simulators trip over signals
-- named after them.
timeUnits :: [Identifier]
timeUnits :: [Identifier]
timeUnits = [Identifier
"fs", Identifier
"ps", Identifier
"ns", Identifier
"us", Identifier
"ms", Identifier
"sec", Identifier
"min", Identifier
"hr"]

-- | Identifiers which are imported from the following:
--
-- use IEEE.STD_LOGIC_1164.ALL;
-- use IEEE.NUMERIC_STD.ALL;
-- use IEEE.MATH_REAL.ALL;
-- use std.textio.all;
--
-- Clash should not use these identifiers, as it can lead to errors when
-- interfacing with an EDA tool.
--
-- See https://github.com/clash-lang/clash-compiler/issues/1439.
--
importedNames :: [Identifier]
importedNames :: [Identifier]
importedNames =
  [ -- ieee.std_logic_1164.all
    Identifier
"std_ulogic", Identifier
"std_ulogic_vector", Identifier
"resolved", Identifier
"std_logic", Identifier
"std_logic_vector"
  , Identifier
"x01", Identifier
"x01z", Identifier
"ux01", Identifier
"ux01z", Identifier
"to_bit", Identifier
"to_bitvector", Identifier
"to_stdulogic"
  , Identifier
"to_stdlogicvector", Identifier
"to_stdulogicvector", Identifier
"to_01", Identifier
"to_x01", Identifier
"to_x01z"
  , Identifier
"to_ux01", Identifier
"rising_edge", Identifier
"falling_edge", Identifier
"is_x"
    -- ieee.numeric_std.all
  , Identifier
"unresolved_unsigned", Identifier
"unresolved_signed", Identifier
"u_unsigned", Identifier
"u_signed"
  , Identifier
"unsigned", Identifier
"signed", Identifier
"find_leftmost", Identifier
"find_rightmost", Identifier
"minimum"
  , Identifier
"maximum", Identifier
"shift_left", Identifier
"shift_right", Identifier
"rotate_left", Identifier
"rotate_right"
  , Identifier
"resize", Identifier
"to_integer", Identifier
"to_unsigned", Identifier
"to_signed", Identifier
"std_match"
    -- ieee.math_real.all
  , Identifier
"math_e", Identifier
"math_1_over_e", Identifier
"math_pi", Identifier
"math_2_pi", Identifier
"math_1_over_pi"
  , Identifier
"math_pi_over_2", Identifier
"math_pi_over_3", Identifier
"path_pi_over_4", Identifier
"path_3_pi_over_2"
  , Identifier
"math_log_of_2", Identifier
"math_log_of_10", Identifier
"math_log10_of_e", Identifier
"math_sqrt_2"
  , Identifier
"math_1_over_sqrt_2", Identifier
"math_sqrt_pi", Identifier
"math_deg_to_rad", Identifier
"math_rad_to_deg"
  , Identifier
"sign", Identifier
"ceil", Identifier
"floor", Identifier
"round", Identifier
"trunc", Identifier
"realmax", Identifier
"realmin", Identifier
"uniform"
  , Identifier
"sqrt", Identifier
"cbrt", Identifier
"exp", Identifier
"log", Identifier
"log2", Identifier
"log10", Identifier
"sin", Identifier
"cos", Identifier
"tan", Identifier
"arcsin"
  , Identifier
"arccos", Identifier
"arctan", Identifier
"sinh", Identifier
"cosh", Identifier
"tanh", Identifier
"arcsinh", Identifier
"arccosh", Identifier
"arctanh"
    -- std.textio.all
  , Identifier
"line", Identifier
"text", Identifier
"side", Identifier
"width", Identifier
"justify", Identifier
"input", Identifier
"output", Identifier
"readline"
  , Identifier
"read", Identifier
"sread", Identifier
"string_read", Identifier
"bread", Identifier
"binary_read", Identifier
"oread", Identifier
"octal_read"
  , Identifier
"hread", Identifier
"hex_read", Identifier
"writeline", Identifier
"tee", Identifier
"write", Identifier
"swrite", Identifier
"string_write"
  , Identifier
"bwrite", Identifier
"binary_write", Identifier
"owrite", Identifier
"octal_write", Identifier
"hwrite", Identifier
"hex_write"
  ]

-- List of reserved VHDL-2008 keywords
-- + used internal names: toslv, fromslv, tagtoenum, datatotag
-- + used IEEE library names: integer, boolean, std_logic, std_logic_vector,
--   signed, unsigned, to_integer, to_signed, to_unsigned, string
reservedWords :: [Identifier]
reservedWords :: [Identifier]
reservedWords = [Identifier
"abs",Identifier
"access",Identifier
"after",Identifier
"alias",Identifier
"all",Identifier
"and",Identifier
"architecture"
  ,Identifier
"array",Identifier
"assert",Identifier
"assume",Identifier
"assume_guarantee",Identifier
"attribute",Identifier
"begin",Identifier
"block"
  ,Identifier
"body",Identifier
"buffer",Identifier
"bus",Identifier
"case",Identifier
"component",Identifier
"configuration",Identifier
"constant",Identifier
"context"
  ,Identifier
"cover",Identifier
"default",Identifier
"disconnect",Identifier
"downto",Identifier
"else",Identifier
"elsif",Identifier
"end",Identifier
"entity",Identifier
"exit"
  ,Identifier
"fairness",Identifier
"file",Identifier
"for",Identifier
"force",Identifier
"function",Identifier
"generate",Identifier
"generic",Identifier
"group"
  ,Identifier
"guarded",Identifier
"if",Identifier
"impure",Identifier
"in",Identifier
"inertial",Identifier
"inout",Identifier
"is",Identifier
"label",Identifier
"library"
  ,Identifier
"linkage",Identifier
"literal",Identifier
"loop",Identifier
"map",Identifier
"mod",Identifier
"nand",Identifier
"new",Identifier
"next",Identifier
"nor",Identifier
"not",Identifier
"null"
  ,Identifier
"of",Identifier
"on",Identifier
"open",Identifier
"or",Identifier
"others",Identifier
"out",Identifier
"package",Identifier
"parameter",Identifier
"port",Identifier
"postponed"
  ,Identifier
"procedure",Identifier
"process",Identifier
"property",Identifier
"protected",Identifier
"pure",Identifier
"range",Identifier
"record"
  ,Identifier
"register",Identifier
"reject",Identifier
"release",Identifier
"rem",Identifier
"report",Identifier
"restrict",Identifier
"restrict_guarantee"
  ,Identifier
"return",Identifier
"rol",Identifier
"ror",Identifier
"select",Identifier
"sequence",Identifier
"severity",Identifier
"signal",Identifier
"shared",Identifier
"sla"
  ,Identifier
"sll",Identifier
"sra",Identifier
"srl",Identifier
"strong",Identifier
"subtype",Identifier
"then",Identifier
"to",Identifier
"transport",Identifier
"type"
  ,Identifier
"unaffected",Identifier
"units",Identifier
"until",Identifier
"use",Identifier
"variable",Identifier
"vmode",Identifier
"vprop",Identifier
"vunit",Identifier
"wait"
  ,Identifier
"when",Identifier
"while",Identifier
"with",Identifier
"xnor",Identifier
"xor",Identifier
"toslv",Identifier
"fromslv",Identifier
"tagtoenum",Identifier
"datatotag"
  ,Identifier
"integer", Identifier
"boolean", Identifier
"std_logic", Identifier
"std_logic_vector", Identifier
"signed", Identifier
"unsigned"
  ,Identifier
"to_integer", Identifier
"to_signed", Identifier
"to_unsigned", Identifier
"string",Identifier
"log"] [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier]
timeUnits [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier]
importedNames

filterReserved :: Identifier -> Identifier
filterReserved :: Identifier -> Identifier
filterReserved Identifier
s = if Identifier
s Identifier -> [Identifier] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Identifier]
reservedWords
  then Identifier
s Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_r"
  else Identifier
s

stripTrailingUnderscore :: Identifier -> Identifier
stripTrailingUnderscore :: Identifier -> Identifier
stripTrailingUnderscore = (Char -> Bool) -> Identifier -> Identifier
TextS.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')

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

  let grouped :: [[Identifier]]
grouped = [Identifier] -> [[Identifier]]
forall a. Eq a => [a] -> [[a]]
group ([Identifier] -> [[Identifier]]) -> [Identifier] -> [[Identifier]]
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Identifier]
forall a. Ord a => [a] -> [a]
sort ([Identifier] -> [Identifier]) -> [Identifier] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ [Identifier]
hFields
      counted :: HashMap Identifier Int
counted = [(Identifier, Int)] -> HashMap Identifier Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMapS.fromList (([Identifier] -> (Identifier, Int))
-> [[Identifier]] -> [(Identifier, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Identifier
g:[Identifier]
gs) -> (Identifier
g, Int -> Int
forall a. Enum a => a -> a
succ ([Identifier] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Identifier]
gs))) [[Identifier]]
grouped)
      names :: [Identifier]
names   = (HashMap Identifier Int, [Identifier]) -> [Identifier]
forall a b. (a, b) -> b
snd ((HashMap Identifier Int, [Identifier]) -> [Identifier])
-> (HashMap Identifier Int, [Identifier]) -> [Identifier]
forall a b. (a -> b) -> a -> b
$ (HashMap Identifier Int
 -> Identifier -> (HashMap Identifier Int, Identifier))
-> HashMap Identifier Int
-> [Identifier]
-> (HashMap Identifier Int, [Identifier])
forall (t :: Type -> Type) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (HashMap Identifier Int
-> HashMap Identifier Int
-> Identifier
-> (HashMap Identifier Int, Identifier)
name' HashMap Identifier Int
counted) HashMap Identifier Int
forall k v. HashMap k v
HashMapS.empty [Identifier]
hFields

  [Identifier] -> VHDLM [Identifier]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Identifier]
names
 where
  hName
    :: Maybe Identifier
    -> HWType
    -> VHDLM Identifier
  hName :: Maybe Identifier -> HWType -> Mon (State VHDLState) Identifier
hName Maybe Identifier
Nothing HWType
field  =
    HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
False HWType
field
  hName (Just Identifier
label) HWType
_field = do
    State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic State VHDLState (Identifier -> Identifier)
-> State VHDLState Identifier -> State VHDLState Identifier
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Identifier -> State VHDLState Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Identifier
label)

  name'
    :: HashMap TextS.Text Int
    -> HashMap TextS.Text Int
    -> TextS.Text
    -> (HashMap TextS.Text Int, TextS.Text)
  name' :: HashMap Identifier Int
-> HashMap Identifier Int
-> Identifier
-> (HashMap Identifier Int, Identifier)
name' HashMap Identifier Int
counted HashMap Identifier Int
countMap Identifier
fieldName
    | HashMap Identifier Int
counted HashMap Identifier Int -> Identifier -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMapS.! Identifier
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 Identifier Int
countMap' = (Maybe Int -> Maybe Int)
-> Identifier -> HashMap Identifier Int -> HashMap Identifier 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' Identifier
fieldName HashMap Identifier Int
countMap in
        -- Each field will get a distinct number:
        let count :: Int
count = HashMap Identifier Int
countMap' HashMap Identifier Int -> Identifier -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMapS.! Identifier
fieldName in
        (HashMap Identifier Int
countMap', [Identifier] -> Identifier
TextS.concat [Identifier
fieldName, Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
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 Identifier Int
countMap, Identifier
fieldName)

productFieldName
  :: HasCallStack
  => Maybe [TextS.Text]
  -- ^ Label hints. From user records, for example.
  -> [HWType]
  -- ^ Field types
  -> Int
  -- ^ Index of field
  -> VHDLM Doc
productFieldName :: Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
productFieldName Maybe [Identifier]
labels [HWType]
fields Int
fieldIndex = do
  -- TODO: cache
  [Identifier]
names <- HasCallStack =>
Maybe [Identifier] -> [HWType] -> VHDLM [Identifier]
Maybe [Identifier] -> [HWType] -> VHDLM [Identifier]
productFieldNames Maybe [Identifier]
labels [HWType]
fields
  Doc -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty ([Identifier]
names [Identifier] -> Int -> Identifier
forall a. [a] -> Int -> a
!! Int
fieldIndex))

selectProductField
  :: HasCallStack
  => Maybe [TextS.Text]
  -- ^ Label hints. From user records, for example.
  -> [HWType]
  -- ^ Field types
  -> Int
  -- ^ Index of field
  -> VHDLM Doc
selectProductField :: Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
productFieldName Maybe [Identifier]
fieldLabels [HWType]
fieldTypes Int
fieldIndex

-- | Generate VHDL for a Netlist component
genVHDL :: Identifier -> SrcSpan -> HashMapS.HashMap Identifier Word -> Component -> VHDLM ((String,Doc),[(String,Doc)])
genVHDL :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL Identifier
nm SrcSpan
sp HashMap Identifier Word
seen Component
c = Mon (State VHDLState) ((String, Doc), [(String, Doc)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
forall s a. Backend s => Mon (State s) a -> Mon (State s) a
preserveSeen (Mon (State VHDLState) ((String, Doc), [(String, Doc)])
 -> Mon (State VHDLState) ((String, Doc), [(String, Doc)]))
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
forall a b. (a -> b) -> a -> b
$ do
    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
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> VHDLState -> Identity VHDLState)
-> HashMap Identifier Word -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= HashMap Identifier Word
seen
    -- Don't have type names conflict with component names
    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
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashMap Identifier Word)
tySeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> VHDLState -> Identity VHDLState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Word -> Word -> Word)
-> HashMap Identifier Word
-> HashMap Identifier Word
-> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith Word -> Word -> Word
forall a. Ord a => a -> a -> a
max HashMap Identifier Word
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 ((Identifier -> String
TextS.unpack 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 <- Identifier -> Mon (State VHDLState) Doc
tyImports Identifier
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_ :: Identifier
             -> [HWType]
             -> VHDLM [(String,Doc)]
mkTyPackage_ :: Identifier -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage_ Identifier
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
    ; Identifier -> Identifier
mkId <- State VHDLState (Identifier -> Identifier)
-> Mon (State VHDLState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic)
    ; 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
<$> (Identifier -> String
TextS.unpack (Identifier -> String) -> Identifier -> String
forall a b. (a -> b) -> a -> b
$ Identifier -> Identifier
mkId (Identifier
modName Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_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
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
mkId (Identifier
modName Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_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
        { Identifier -> Identifier
mkId <- State VHDLState (Identifier -> Identifier)
-> Mon (State VHDLState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic)
        ; 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
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
mkId (Identifier
modName Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_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 Identifier
_ Maybe [Identifier]
_ [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 Identifier
_ [(Identifier, [HWType])]
elTys           -> (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Identifier, [HWType])]
elTys)
  BiDirectional PortDirection
_ HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
  Annotated [Attr']
_ HWType
elTy     -> HWType -> [HWType]
mkUsedTys HWType
elTy
  CustomProduct Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ [(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 Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
tys0 ->
    let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (ConstrRepr'
_repr, Identifier
_id, [HWType]
tys) <- [(ConstrRepr', Identifier, [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 Identifier
_ Maybe [Identifier]
_ [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 Identifier
_ [(Identifier, [HWType])]
tys0) =
      let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat (((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [[HWType]]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Identifier, [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 Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
tys0) =
      let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (ConstrRepr'
_repr, Identifier
_id, [HWType]
tys) <- [(ConstrRepr', Identifier, [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 Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ (((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 Identifier
_ Maybe [Identifier]
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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 Identifier
_           -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    Reset Identifier
_           -> 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 Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_  -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    SP Identifier
_ [(Identifier, [HWType])]
_            -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    Sum Identifier
_ [Identifier]
_           -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ -> 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

    -- 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

    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]
++ HWType -> String
forall a. Show a => a -> String
show HWType
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 Identifier
_ Maybe [Identifier]
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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 :: Identifier -> VHDLM Doc
tyImports :: Identifier -> Mon (State VHDLState) Doc
tyImports Identifier
nm = do
  Identifier -> Identifier
mkId <- State VHDLState (Identifier -> Identifier)
-> Mon (State VHDLState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic)
  [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
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
mkId (Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_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
     => TextS.Text
     -> HWType
     -> VHDLM Doc
     -> Int
     -> Maybe Expr
     -> VHDLM (Doc, t)
port :: Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port Identifier
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
$ Identifier -> Int
TextS.length Identifier
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 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
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      = [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs [(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
<> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs [(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 Identifier
_ 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 Identifier
_ 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)])
  => [(TextS.Text, Attr')]
  -> t
attrMap :: [(Identifier, Attr')] -> t
attrMap [(Identifier, Attr')]
attrs = (t -> (Identifier, Attr') -> t) -> t -> [(Identifier, Attr')] -> t
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl t -> (Identifier, Attr') -> t
go t
HashMap Text (Text, [(Identifier, Text)])
empty' [(Identifier, Attr')]
attrs
 where
  empty' :: HashMap Text (Text, [(Identifier, Text)])
empty' = [(Text, (Text, [(Identifier, Text)]))]
-> HashMap Text (Text, [(Identifier, 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 (((Identifier, Attr') -> Attr') -> [(Identifier, Attr')] -> [Attr']
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, Attr') -> Attr'
forall a b. (a, b) -> b
snd [(Identifier, Attr')]
attrs)

  go :: t -> (TextS.Text, Attr') -> t
  go :: t -> (Identifier, Attr') -> t
go t
map' (Identifier, Attr')
attr = ((Text, [(Identifier, Text)]) -> (Text, [(Identifier, Text)]))
-> Text
-> HashMap Text (Text, [(Identifier, Text)])
-> HashMap Text (Text, [(Identifier, Text)])
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust
                   ((Identifier, Attr')
-> (Text, [(Identifier, Text)]) -> (Text, [(Identifier, Text)])
go' (Identifier, 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
$ (Identifier, Attr') -> Attr'
forall a b. (a, b) -> b
snd (Identifier, Attr')
attr)
                   t
HashMap Text (Text, [(Identifier, Text)])
map'

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

renderAttrs
  :: [(TextS.Text, Attr')]
  -> VHDLM Doc
renderAttrs :: [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs ([(Identifier, Attr')] -> HashMap Text (Text, [(Identifier, Text)])
forall t.
(t ~ HashMap Text (Text, [(Identifier, Text)])) =>
[(Identifier, Attr')] -> t
attrMap -> HashMap Text (Text, [(Identifier, 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, [(Identifier, Text)])) -> Mon (State VHDLState) Doc)
-> [(Text, (Text, [(Identifier, Text)]))]
-> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, [(Identifier, Text)])) -> Mon (State VHDLState) Doc
renderAttrGroup (HashMap Text (Text, [(Identifier, Text)])
-> [(Text, (Text, [(Identifier, Text)]))]
forall a b. (Eq a, Hashable a) => HashMap a b -> [(a, b)]
assocs HashMap Text (Text, [(Identifier, Text)])
attrs)
 where
  renderAttrGroup
    :: (T.Text, (T.Text, [(TextS.Text, T.Text)]))
    -> VHDLM Doc
  renderAttrGroup :: (Text, (Text, [(Identifier, Text)])) -> Mon (State VHDLState) Doc
renderAttrGroup (Text
attrname, (Text
typ, [(Identifier, 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
$ ((Identifier, Text) -> Mon (State VHDLState) Doc)
-> [(Identifier, Text)] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> (Identifier, Text) -> Mon (State VHDLState) Doc
renderAttrDecl Text
attrname) [(Identifier, Text)]
elems)

  renderAttrDecl
    :: T.Text
    -> (TextS.Text, T.Text)
    -> VHDLM Doc
  renderAttrDecl :: Text -> (Identifier, Text) -> Mon (State VHDLState) Doc
renderAttrDecl Text
attrname (Identifier
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
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
signalName
    Mon (State VHDLState) Doc
-> 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
"signal 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

-- | Return all key/value pairs in the map in arbitrary key order.
assocs :: Eq a => Hashable a => HashMap a b -> [(a,b)]
assocs :: HashMap a b -> [(a, b)]
assocs HashMap a b
m = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
keys ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap a b
m HashMap a b -> a -> b
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.!) [a]
keys)
 where
  keys :: [a]
keys = (HashMap a b -> [a]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap a b
m)

-- | 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
    Identifier
modName <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm)
    Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
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
  Identifier
nm <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
False HWType
t
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
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) Identifier
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 {} ->
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Identifier
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
_ ->
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Identifier
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          -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"boolean"
    Signed Int
n      ->
      let app :: [Identifier]
app = if Bool
rec0 then [Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n] else [] in
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Mon (State VHDLState) Identifier)
-> Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
TextS.concat ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier
"signed" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
    Unsigned Int
n    ->
      let app :: [Identifier]
app = if Bool
rec0 then [Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n] else [] in
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Mon (State VHDLState) Identifier)
-> Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
TextS.concat ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier
"unsigned" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
    BitVector Int
n   ->
      let app :: [Identifier]
app = if Bool
rec0 then [Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n] else [] in
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Mon (State VHDLState) Identifier)
-> Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
TextS.concat ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier
"std_logic_vector" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
    HWType
String        -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"string"
    HWType
Integer       -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"integer"
    HWType
Bit           -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"std_logic"
    Vector Int
n HWType
elTy -> do
      Identifier
elTy' <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
True HWType
elTy
      let nm :: Identifier
nm = [Identifier] -> Identifier
TextS.concat [ Identifier
"array_of_"
                            , if Bool
rec0 then Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_" else Identifier
""
                            , Identifier
elTy']
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> State VHDLState Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
nm)
    RTree Int
n HWType
elTy  -> do
      Identifier
elTy' <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
True HWType
elTy
      let nm :: Identifier
nm = [Identifier] -> Identifier
TextS.concat [ Identifier
"tree_of_"
                            , if Bool
rec0 then Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_" else Identifier
""
                            , Identifier
elTy']
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> State VHDLState Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
nm)
    -- TODO: nice formatting for Index. I.e., 2000 = 2e3, 1024 = 2pow10
    Index FieldAnn
n ->
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier
"index_" Identifier -> Identifier -> Identifier
`TextS.append` FieldAnn -> Identifier
forall a. TextShow a => a -> Identifier
showt FieldAnn
n)
    Clock Identifier
nm0 ->
      let nm1 :: Identifier
nm1 = Identifier
"clk_" Identifier -> Identifier -> Identifier
`TextS.append` Identifier
nm0 in
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"clk" Identifier
nm1 HWType
t)
    Reset Identifier
nm0 ->
      let nm1 :: Identifier
nm1 = Identifier
"rst_" Identifier -> Identifier -> Identifier
`TextS.append` Identifier
nm0 in
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"rst" Identifier
nm1 HWType
t)
    Sum Identifier
nm [Identifier]
_  ->
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sum" Identifier
nm HWType
t)
    CustomSum Identifier
nm DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ ->
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sum" Identifier
nm HWType
t)
    SP Identifier
nm [(Identifier, [HWType])]
_ ->
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sp" Identifier
nm HWType
t)
    CustomSP Identifier
nm DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_ ->
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sp" Identifier
nm HWType
t)
    Product Identifier
nm Maybe [Identifier]
_ [HWType]
_ ->
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"product" Identifier
nm HWType
t)
    CustomProduct Identifier
nm DataRepr'
_ Int
_ Maybe [Identifier]
_ [(FieldAnn, HWType)]
_ ->
      State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
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) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"product" Identifier
nm HWType
t)
    Annotated [Attr']
_ HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 HWType
hwTy
    BiDirectional PortDirection
_ HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 HWType
hwTy
    HWType
FileType -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"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 Identifier
_ Maybe [Identifier]
_ [HWType]
_ -> HWType
hwty

  -- Simple types, for which a subtype (without qualifiers) will be made in VHDL:
  Clock Identifier
_           -> HWType
Bit
  Reset Identifier
_           -> HWType
Bit
  Index FieldAnn
_           -> Int -> HWType
Unsigned (HWType -> Int
typeSize HWType
hwty)
  CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_  -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  SP Identifier
_ [(Identifier, [HWType])]
_            -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  Sum Identifier
_ [Identifier]
_           -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ -> 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 Identifier
_           -> HWType
hwty
  Reset Identifier
_           -> HWType
hwty
  Index FieldAnn
_           -> HWType
hwty
  Sum Identifier
_ [Identifier]
_           -> HWType
hwty
  CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ -> 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 Identifier
nm Maybe [Identifier]
labels [HWType]
elTys  ->
    Identifier -> Maybe [Identifier] -> [HWType] -> HWType
Product Identifier
nm Maybe [Identifier]
labels ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
elTys)

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

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

  CustomProduct Identifier
nm0 DataRepr'
drepr Int
size Maybe [Identifier]
maybeFieldNames [(FieldAnn, HWType)]
constrs ->
    Identifier
-> DataRepr'
-> Int
-> Maybe [Identifier]
-> [(FieldAnn, HWType)]
-> HWType
CustomProduct Identifier
nm0 DataRepr'
drepr Int
size Maybe [Identifier]
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
  :: Identifier
  -- ^ Default name
  -> Identifier
  -- ^ Identifier stored in @hwTy@
  -> HWType
  -- ^ Type to give a (unique) name
  -> StateT VHDLState Identity TextS.Text
userTyName :: Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
dflt Identifier
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
  HashMap Identifier Word
seen <- Getting
  (HashMap Identifier Word) VHDLState (HashMap Identifier Word)
-> StateT VHDLState Identity (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (HashMap Identifier Word) VHDLState (HashMap Identifier Word)
Lens' VHDLState (HashMap Identifier Word)
tySeen
  Identifier -> Identifier
mkId <- State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic
  let nm1 :: Identifier
nm1 = (Identifier -> Identifier
mkId (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identifier] -> Identifier
forall a. [a] -> a
last ([Identifier] -> Identifier)
-> (Identifier -> [Identifier]) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier -> [Identifier]
TextS.splitOn Identifier
".") Identifier
nm0
      nm2 :: Identifier
nm2 = if Identifier -> Bool
TextS.null Identifier
nm1 then Identifier
dflt else Identifier
nm1
      (Identifier
nm3,Word
count) = case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
nm2 HashMap Identifier Word
seen of
                      Just Word
cnt -> (Identifier -> Identifier)
-> HashMap Identifier Word
-> Word
-> Identifier
-> (Identifier, Word)
forall b t v.
(Show b, Num b) =>
t -> HashMap Identifier v -> b -> Identifier -> (Identifier, b)
go Identifier -> Identifier
mkId HashMap Identifier Word
seen Word
cnt Identifier
nm2
                      Maybe Word
Nothing  -> (Identifier
nm2,Word
0)
  (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashMap Identifier Word)
tySeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> VHDLState -> Identity VHDLState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
nm3 Word
count
  Identifier -> State VHDLState Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
nm3
  where
    go :: t -> HashMap Identifier v -> b -> Identifier -> (Identifier, b)
go t
mkId HashMap Identifier v
seen b
count Identifier
nm0' =
      let nm1' :: Identifier
nm1' = Identifier
nm0' Identifier -> Identifier -> Identifier
`TextS.append` String -> Identifier
TextS.pack (Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:b -> String
forall a. Show a => a -> String
show b
count) in
      case Identifier -> HashMap Identifier v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
nm1' HashMap Identifier v
seen of
        Just v
_  -> t -> HashMap Identifier v -> b -> Identifier -> (Identifier, b)
go t
mkId HashMap Identifier v
seen (b
countb -> b -> b
forall a. Num a => a -> a -> a
+b
1) Identifier
nm0'
        Maybe v
Nothing -> (Identifier
nm1',b
countb -> b -> b
forall a. Num a => a -> a -> a
+b
1)


-- | 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 Identifier
_ Maybe [Identifier]
_ [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 (Reset {}) = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Clock Identifier
_)  = 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 Identifier
_ Maybe [Identifier]
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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] -> 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 ([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 Identifier
noteM WireOrReg
_ Identifier
id_ Either Identifier 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 (Identifier -> Int
TextS.length 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)
-> (Identifier
    -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> 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 Identifier
-> 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 Identifier
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
<+> (Identifier -> Mon (State VHDLState) Doc)
-> (HWType -> Mon (State VHDLState) Doc)
-> Either Identifier HWType
-> Mon (State VHDLState) Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty HWType -> Mon (State VHDLState) Doc
sizedQualTyName Either Identifier 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)
  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 Identifier
_ Identifier
nm Identifier
_ [(Expr, HWType, Expr)]
gens [(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"
  }
 where
    formalLength :: Expr -> p
formalLength (Identifier Identifier
i Maybe Modifier
_) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Identifier -> Int
TextS.length Identifier
i)
    formalLength Expr
_                = p
0

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

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 Identifier
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Identifier)]
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' Identifier
_name Int
_n FieldAnn
mask FieldAnn
value [FieldAnn]
_anns), Identifier
_id) = [(ConstrRepr', Identifier)]
reprs [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i

patLitCustom Mon (State VHDLState) Doc
var (CustomSP Identifier
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Identifier, [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' Identifier
_name Int
_n FieldAnn
mask FieldAnn
value [FieldAnn]
_anns), Identifier
_id, [HWType]
_tys) = [(ConstrRepr', Identifier, [HWType])]
reprs [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [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 Identifier
id_:[Declaration]
ds) = Identifier -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
Identifier -> Identifier -> f Doc
comment Identifier
"--" 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
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_' :: TextS.Text -> 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 Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [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 Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_) [(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 Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ [(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 Identifier
libM Identifier
nm Identifier
lbl [(Expr, HWType, Expr)]
gens [(Expr, PortDirection, HWType, Expr)]
pms) = do
    Mon (State VHDLState) ()
-> (Identifier -> Mon (State VHDLState) ())
-> Maybe Identifier
-> 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 ()) (\Identifier
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 ()
%= (Identifier -> Text
T.fromStrict Identifier
libText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))) Maybe Identifier
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
-> (Identifier -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> 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)
-> (Identifier -> Mon (State VHDLState) Doc)
-> Identifier
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
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
pms' Mon (State VHDLState) Doc
-> Mon (State VHDLState) 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
    pms' :: Mon (State VHDLState) Doc
pms' = 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,PortDirection
_,HWType
_,Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms]
      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)
    formalLength :: Expr -> p
formalLength (Identifier Identifier
i Maybe Modifier
_) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Identifier -> Int
TextS.length 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 Identifier
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), 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]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), 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 Identifier
_ [(Identifier, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = Mon (State VHDLState) Doc
assignExpr
  where
    argTys :: [HWType]
argTys     = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])]
args [(Identifier, [HWType])] -> Int -> (Identifier, [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 Identifier
_ [Identifier]
_) (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 Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
tys) (DC (HWType
_,Int
i)) []) =
  let (ConstrRepr' Identifier
_ Int
_ FieldAnn
_ FieldAnn
value [FieldAnn]
_) = (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
tys [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
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 Identifier
_ DataRepr'
dataRepr Int
_size [(ConstrRepr', Identifier, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) =
  let (ConstrRepr'
cRepr, Identifier
_, [HWType]
argTys) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [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 Identifier
_ DataRepr'
dataRepr Int
_size Maybe [Identifier]
_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 Identifier
_ Maybe [Identifier]
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"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 Identifier
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), 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]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), 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 Identifier
_ [Identifier]
_) (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 Identifier
_ [Identifier]
_) (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 Identifier
_ [(Identifier, [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
_ (ConvBV Maybe Identifier
topM HWType
hwty Bool
True Expr
e) = do
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  case Maybe Identifier
topM of
    Maybe Identifier
Nothing -> 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
"_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
_ (ConvBV Maybe Identifier
topM HWType
_ Bool
False Expr
e) = do
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
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 (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
"_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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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 Identifier
_ [Identifier]
_)    Expr
e = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV (CustomSum Identifier
_ DataRepr'
_dataRepr Int
size [(ConstrRepr', Identifier)]
reprs) (DataCon HWType
_ (DC (HWType
_,Int
i)) [Expr]
_) =
  let (ConstrRepr' Identifier
_ Int
_ FieldAnn
_ FieldAnn
value [FieldAnn]
_) = (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
reprs [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
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 Identifier
_ Maybe [Identifier]
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 (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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 Identifier
_ Maybe [Identifier]
_ [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 Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ [(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 Identifier
_ Maybe [Identifier]
_ [HWType]
_) Expr
e = do
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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 Identifier
_ [(Identifier, [HWType])]
_) Expr
e       = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV (CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [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 (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm)
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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 Identifier
_)  = 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 Identifier
_ ) = 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 (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 Identifier
_ [(Identifier, [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   = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd (String -> [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"SOP type: invalid constructor index" [(Identifier, [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 Identifier
_ Maybe [Identifier]
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 [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
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.Driver.TopWrapper.mkOutput
-- 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.Driver.TopWrapper.mkOutput
-- 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 Identifier
_ DataRepr'
dataRepr Int
size [(ConstrRepr', Identifier, [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' Identifier
_name Int
_n FieldAnn
_mask FieldAnn
_value [FieldAnn]
anns, Identifier
_, [HWType]
argTys) =
    String
-> [(ConstrRepr', Identifier, [HWType])]
-> Int
-> (ConstrRepr', Identifier, [HWType])
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid constructor index" [(ConstrRepr', Identifier, [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 Identifier
_ DataRepr'
dataRepr Int
size Maybe [Identifier]
_ [(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' Identifier
_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 Identifier
_ [(Identifier, [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
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
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 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower 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
"_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)