{-|
  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.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.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, traceIf, (<:>),
   indexNote)
import           Clash.Util.Graph                     (reverseTopSort)

-- | 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 ""
                              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.</> "common"
                                      , String
root String -> String -> String
System.FilePath.</> "vhdl"
                                      ]
  extractTypes :: VHDLState -> HashSet HWType
extractTypes    = VHDLState -> HashSet HWType
_tyCache
  name :: VHDLState -> String
name            = String -> VHDLState -> String
forall a b. a -> b -> a
const "vhdl"
  extension :: VHDLState -> String
extension       = String -> VHDLState -> String
forall a b. a -> b -> a
const ".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 Internal      (HWType -> HWType
filterTransparent -> HWType
ty) = HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
ty
  hdlType (External nm :: 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
      Bit         -> Mon (State VHDLState) Doc
sized
      Bool        -> Mon (State VHDLState) Doc
sized
      Signed _    -> Mon (State VHDLState) Doc
sized
      Unsigned _  -> Mon (State VHDLState) Doc
sized
      BitVector _ -> Mon (State VHDLState) Doc
sized
      _           -> 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 t :: Text
t ty :: 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 _ id_ :: Text
id_      = 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
<> "_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 (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
  fromBV :: HWType -> Text -> Mon (State VHDLState) Doc
fromBV _ id_ :: Text
id_  = 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
<> "_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 _ Basic nm :: 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
          nm' :: Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> "clash_internal"
              | Bool
otherwise -> Identifier
nm'
      go esc :: Bool
esc Extended (Identifier -> Identifier
rmSlash -> Identifier
nm) = case Bool -> IdType -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm of
        nm' :: 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
nm,"\\"]
            | 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 _ Basic nm :: Identifier
nm ext :: 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
          nm' :: Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> "clash_internal"
              | Bool
otherwise -> Identifier
nm'
      go esc :: Bool
esc 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) ext :: 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
              nm' :: 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 "c$" Identifier
nmExt of
                      True -> [Identifier] -> Identifier
TextS.concat ["\\",Identifier
nmExt,"\\"]
                      _    -> [Identifier] -> Identifier
TextS.concat ["\\c$",Identifier
nmExt,"\\"]
                  | Bool
otherwise -> Identifier
nm'

  setModName :: Identifier -> VHDLState -> VHDLState
setModName nm :: Identifier
nm s :: 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 nm :: Identifier
nm ds :: [Declaration]
ds = do
    Doc
decs <- [Declaration] -> Mon (State VHDLState) Doc
decls [Declaration]
ds
    let attrs :: [(Identifier, Attr')]
attrs = [ (Identifier
id_, Attr'
attr)
                | NetDecl' _ _ id_ :: Identifier
id_ (Right hwtype :: HWType
hwtype) _ <- [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 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
<+> "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 2
              ("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
<>
            "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 inc :: [(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 libs :: [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 imps :: [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 f :: 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 (fs' :: [(String, String)]
fs',f' :: 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 f :: (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 _ = Bool
False

rmSlash :: Identifier -> Identifier
rmSlash :: Identifier -> Identifier
rmSlash nm :: 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
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
== '\\')) Identifier
nm1)

type VHDLM a = Mon (State VHDLState) a

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

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

filterReserved :: Identifier -> Identifier
filterReserved :: Identifier -> Identifier
filterReserved s :: 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` "_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
== '_')

-- | 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 labels0 :: Maybe [Identifier]
labels0 fields :: [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 (\(g :: Identifier
g:gs :: [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 Nothing field :: HWType
field  =
    HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
False HWType
field
  hName (Just label :: Identifier
label) _field :: 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' counted :: HashMap Identifier Int
counted countMap :: HashMap Identifier Int
countMap fieldName :: Identifier
fieldName
    | HashMap Identifier Int
counted HashMap Identifier Int -> Identifier -> Int
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> v
HashMapS.! Identifier
fieldName Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 =
        -- Seen this fieldname more than once, so we need to add a number
        -- as a postfix:
        let succ' :: Maybe Int -> Maybe Int
succ' n :: 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 (0 :: Int) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+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) => HashMap k v -> k -> v
HashMapS.! Identifier
fieldName in
        (HashMap Identifier Int
countMap', [Identifier] -> Identifier
TextS.concat [Identifier
fieldName, "_", 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 labels :: Maybe [Identifier]
labels fields :: [HWType]
fields fieldIndex :: 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 fieldLabels :: Maybe [Identifier]
fieldLabels fieldTypes :: [HWType]
fieldTypes fieldIndex :: Int
fieldIndex =
  "_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
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 nm :: Identifier
nm sp :: SrcSpan
sp seen :: HashMap Identifier Word
seen c :: 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
      ("-- 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_ modName :: 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)
          (funDecs :: [Mon (State VHDLState) Doc]
funDecs,funBodies :: [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` "_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
<$>
      "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
<>
      "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
<>
      "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
<>
      "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` "_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
<+> "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 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
<>
      "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 funBodies :: [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
      _  -> 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
<>
         "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
<+> "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` "_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
<+> "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 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
<>
         "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 _) (Signed _)         = Bool
True
    eqTypM (Unsigned _) (Unsigned _)     = Bool
True
    eqTypM (BitVector _) (BitVector _)   = Bool
True
    eqTypM ty1 :: HWType
ty1 ty2 :: HWType
ty2                       = HWType
ty1 HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
ty2

mkUsedTys :: HWType -> [HWType]
mkUsedTys :: HWType -> [HWType]
mkUsedTys hwty :: HWType
hwty = HWType
hwty HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: case HWType
hwty of
  Vector _ elTy :: HWType
elTy        -> HWType -> [HWType]
mkUsedTys HWType
elTy
  RTree _ elTy :: HWType
elTy         -> HWType -> [HWType]
mkUsedTys HWType
elTy
  Product _ _ elTys :: [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 _ elTys :: [(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 _ elTy :: HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
  Annotated _ elTy :: HWType
elTy     -> HWType -> [HWType]
mkUsedTys HWType
elTy
  CustomProduct _ _ _ _ tys0 :: [(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 _ _ _ tys0 :: [(ConstrRepr', Identifier, [HWType])]
tys0 ->
    let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (_repr :: ConstrRepr'
_repr, _id :: Identifier
_id, tys :: [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
  _ ->
    []

topSortHWTys
  :: [HWType]
  -> [HWType]
topSortHWTys :: [HWType] -> [HWType]
topSortHWTys hwtys :: [HWType]
hwtys = [HWType]
sorted
  where
    nodes :: [(Int, HWType)]
nodes  = [Int] -> [HWType] -> [(Int, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 [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 err :: String
err -> String -> [HWType]
forall a. HasCallStack => String -> a
error (String -> [HWType]) -> String -> [HWType]
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "[BUG IN CLASH] topSortHWTys: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        Right ns :: [HWType]
ns -> [HWType]
ns

    -- `elTy` needs to be rendered before `t`
    edge :: HWType -> [(Int, Int)]
edge t :: HWType
t@(Vector _ elTy :: 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 node :: Int
node ->
          [(HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> v
HashMap.! HWType
t, Int
node)]
        Nothing ->
          []

    -- `elTy` needs to be rendered before `t`
    edge t :: HWType
t@(RTree _ elTy :: 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 node :: Int
node ->
          [(HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v. (Eq k, Hashable k) => 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
        Nothing ->
          []

    -- `tys` need to be rendered before `t`
    edge t :: HWType
t@(Product _ _ tys0 :: [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) => 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 _ tys0 :: [(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) => 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 _ _ _ tys0 :: [(ConstrRepr', Identifier, [HWType])]
tys0) =
      let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (_repr :: ConstrRepr'
_repr, _id :: Identifier
_id, tys :: [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) => 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 _ _ _ _ (((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) => HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
tys1)

    edge _ = []

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

typAliasDec :: HasCallStack => HWType -> VHDLM Doc
typAliasDec :: HWType -> Mon (State VHDLState) Doc
typAliasDec hwty :: HWType
hwty =
  "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
<+> "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 hwty :: 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 _ elTy :: HWType
elTy ->
      case HdlSyn
syn of
        Vivado ->
          "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
<+> "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
- 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
<+> "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

        _ ->
          "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
<+> "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 _ elTy :: HWType
elTy ->
      case HdlSyn
syn of
        Vivado ->
          "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
<+> "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
<+> "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
- 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
<+> "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

        _ ->
          "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
<+> "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 _ labels :: Maybe [Identifier]
labels tys :: [HWType]
tys@(_:_:_) ->
      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 (\i :: 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) [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
      "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
<+> "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 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 (\x :: Mon (State VHDLState) Doc
x y :: 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
<>
      "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 _           -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    Reset _           -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    Index _           -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    CustomSP _ _ _ _  -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    SP _ _            -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    Sum _ _           -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
    CustomSum _ _ _ _ -> 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 _ -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Bool        -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Bit         -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Unsigned _  -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Signed _    -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    String      -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
    Integer     -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

    -- Transparent types:
    BiDirectional _ ty :: HWType
ty -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec HWType
ty
    Annotated _ ty :: 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

    _ -> 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
$ $(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 _ Bool = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
  ( "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 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 ["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
<+> "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
<+> "then"
                                ,  Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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 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)
                                ,"else"
                                ,  Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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 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)
                                ,"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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 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 ["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
<+> "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
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 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
<+> "then"
                                ,   Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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
<+> "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)
                                ,"else"
                                ,   Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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
<+> "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)
                                ,"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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 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 ["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
<+> "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f 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 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
<+> "then"
                                ,   Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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
<+> "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)
                                ,"else"
                                ,   Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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
<+> "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)
                                ,"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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 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 ["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
<+> "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
<+> "then"
                                ,  Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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
<+> "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 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)
                                ,"else"
                                ,  Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 2 ("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
<+> "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 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)
                                ,"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
<+> "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
<>
    "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 _ 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
  ( "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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 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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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 2
        ( "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
<>
    "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 2 ("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
<+> "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 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
<>
    "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 _ (Signed _) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
  ( "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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 ("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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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 ("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
<>
    "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 _ (Unsigned _) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
  ( "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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 ("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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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 ("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
<>
    "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 _ t :: HWType
t@(Product _ labels :: Maybe [Identifier]
labels elTys :: [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
  ( "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
<+> "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 ("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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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
<>
    "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 2 ("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]
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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
      "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
<>
    "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 2 ("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]
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
<>
    "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 [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
- 1)]
                     (\i :: Int
i -> "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 ("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     = 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
(+)) 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 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)
                       (\(s :: Int
s,e :: Int
e) -> "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 ("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
<+> "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 syn :: HdlSyn
syn t :: HWType
t@(Vector _ elTy :: 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
  ( "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
<+> "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 ("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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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 2
        ( "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
<> "(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
<>
          "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
<+> "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 ("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
<>
    "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 2
        ("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 2
              (  "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 ("(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
<+> "+ 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
<+>
                                             "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (case HdlSyn
syn of
                                      Vivado -> "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 ("i")
                                      _  -> "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 ("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 ("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
<>
         "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
<+> "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
<>
         "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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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 2
        ( "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
<+> "std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "(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
<>
          "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 ("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
<+> "- 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
<>
    "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 2
        ("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 2
              ( "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 "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> case HdlSyn
syn of
                    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
                    _ | BitVector _ <- 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           -> "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
<>
         "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
<+> "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
<>
         "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
<+> "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
<>
    "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 = "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 ("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
<+> "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
<+> "- 1")

funDec _ (BitVector _) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
  ( "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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
<+> "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
<>
    "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 2 ("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
<+> "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
<>
    "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 syn :: HdlSyn
syn t :: HWType
t@(RTree _ elTy :: 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
  ( "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
<+> "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 ("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
<+> "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
  , "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
<+> "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 ("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
<+> "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
<+> "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 2
        ( "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
<> "(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
<>
          "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
<+> "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 ("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
<>
    "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 2
        ("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 2
              (  "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 ("(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
<+> "+ 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
<+>
                                             "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (case HdlSyn
syn of
                                      Vivado -> "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 ("i")
                                      _ -> "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 ("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 ("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
<>
         "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
<+> "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
<>
         "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
<+> "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
<>
    "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
<>
    "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
<+> "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 ("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
<+> "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
<+> "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
<+> "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
<+> "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 2
        ( "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
<+> "std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "(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
<>
          "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 ("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
<+> "- 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
<>
    "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 2
        ("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 2
              ( "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 "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
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> case HdlSyn
syn of
                    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
                    _ | BitVector _ <- 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           -> "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
<>
         "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
<+> "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
<>
         "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
<+> "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
<>
    "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 = "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 ("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
<+> "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
<+> "- 1")

funDec _ _ = 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 nm :: 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
    ([ "library IEEE"
     , "use IEEE.STD_LOGIC_1164.ALL"
     , "use IEEE.NUMERIC_STD.ALL"
     , "use IEEE.MATH_REAL.ALL"
     , "use std.textio.all"
     , "use work.all"
     , "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` "_types")) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> ".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 (("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 (("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 elName :: Identifier
elName hwType :: HWType
hwType portDirection :: Mon (State VHDLState) Doc
portDirection fillToN :: Int
fillToN iEM :: 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 = "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 c :: 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 (p :: [Doc]
p,ls :: [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))
    "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
<+> "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
         _  -> case HdlSyn
syn of
          -- See: [Note] Hack entity attributes in architecture
          Other -> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 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
<> "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
          _     -> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent 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
<> "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 l :: 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 "in" Int
l Maybe Expr
forall a. Maybe a
Nothing | (iName :: Identifier
iName, hwType :: 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 "out" Int
l Maybe Expr
iEM | (_, (oName :: Identifier
oName, hwType :: HWType
hwType), iEM :: Maybe Expr
iEM) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c]

    rports :: [Doc] -> f Doc
rports p :: [Doc]
p = "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) | (id_ :: Identifier
id_, hwtype :: 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
_wireOrReg, (id_ :: Identifier
id_, hwtype :: HWType
hwtype), _) <- 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 c :: 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
                  Other -> [(Identifier, Attr')]
declAttrs
                  _     -> [(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 2
      (("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
<+> "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 2
      ("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
<>
      "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' _ _ id_ :: Identifier
id_ (Right hwtype :: HWType
hwtype) _ <- [Declaration]
netdecls, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
   inputAttrs :: [(Identifier, Attr')]
inputAttrs  = [(Identifier
id_, Attr'
attr) | (id_ :: Identifier
id_, hwtype :: 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
_wireOrReg, (id_ :: Identifier
id_, hwtype :: HWType
hwtype), _) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]

   isNetDecl :: Declaration -> Bool
   isNetDecl :: Declaration -> Bool
isNetDecl (NetDecl' _ _ _ (Right _) _) = Bool
True
   isNetDecl _                            = Bool
False

attrType
  :: t ~ HashMap T.Text T.Text
  => t
  -> Attr'
  -> t
attrType :: t -> Attr' -> t
attrType types :: t
types attr :: 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
    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 type'' :: 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
$
                      $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ Text -> String
T.unpack Text
name', "already assigned"
                                           , Text -> String
T.unpack Text
type'', "while we tried to"
                                           , "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' _ _    -> "boolean"
            IntegerAttr' _ _ -> "integer"
            StringAttr' _ _  -> "string"
            Attr' _          -> "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 attrs :: [(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) => 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 map' :: t
map' attr :: (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' (signalName :: Identifier
signalName, attr :: Attr'
attr) (typ :: Text
typ, elems :: [(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]
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 (attrname :: Text
attrname, (typ :: Text
typ, elems :: [(Identifier, Text)]
elems)) =
    ("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 attrname :: Text
attrname (signalName :: Identifier
signalName, value :: Text
value) =
        "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
<+> "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
<+> "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 m :: 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) => 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'  _key :: String
_key value :: String
value) = 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' _key :: String
_key value :: 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'    _key :: String
_key True ) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "true"
renderAttr (BoolAttr'    _key :: String
_key False) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "false"
renderAttr (Attr'        _key :: String
_key      ) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "true"

sigDecl :: VHDLM Doc -> HWType -> VHDLM Doc
sigDecl :: Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
sigDecl d :: Mon (State VHDLState) Doc
d t :: 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 baseType :: Mon (State VHDLState) Doc
baseType sizedType :: HWType
sizedType = case HWType
sizedType of
  BitVector n :: 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
-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
<+> "downto 0")
  Signed n :: 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
-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
<+> "downto 0")
  Unsigned n :: 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
-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
<+> "downto 0")
  Vector n :: 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 ("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
-1))
  RTree d :: Int
d _   -> 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 ("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 ((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
-1))
  _           -> 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:
  Bit -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
  Bool -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
  Signed _ -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
  Unsigned _ -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
  BitVector _ -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty

  -- Transparent types:
  BiDirectional _ elTy :: HWType
elTy -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy
  Annotated _ elTy :: HWType
elTy -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy

  -- Custom types:
  _ -> 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
<> "_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 t :: 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' rec0 :: 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 ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Forced to print KnownDomain tyName"))
    Void _ ->
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Identifier
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Forced to print Void tyName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
t))
    Bool          -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return "boolean"
    Signed n :: Int
n      ->
      let app :: [Identifier]
app = if Bool
rec0 then ["_", 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
$ "signed" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
    Unsigned n :: Int
n    ->
      let app :: [Identifier]
app = if Bool
rec0 then ["_", 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
$ "unsigned" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
    BitVector n :: Int
n   ->
      let app :: [Identifier]
app = if Bool
rec0 then ["_", 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
$ "std_logic_vector" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
    String        -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return "string"
    Integer       -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return "integer"
    Bit           -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return "std_logic"
    Vector n :: Int
n elTy :: 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 [ "array_of_"
                            , if Bool
rec0 then Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n Identifier -> Identifier -> Identifier
`TextS.append` "_" else ""
                            , 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 n :: Int
n elTy :: 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 [ "tree_of_"
                            , if Bool
rec0 then Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n Identifier -> Identifier -> Identifier
`TextS.append` "_" else ""
                            , 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 n :: FieldAnn
n ->
      Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return ("index_" Identifier -> Identifier -> Identifier
`TextS.append` FieldAnn -> Identifier
forall a. TextShow a => a -> Identifier
showt FieldAnn
n)
    Clock nm0 :: Identifier
nm0 ->
      let nm1 :: Identifier
nm1 = "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 "clk" Identifier
nm1 HWType
t)
    Reset nm0 :: Identifier
nm0 ->
      let nm1 :: Identifier
nm1 = "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 "rst" Identifier
nm1 HWType
t)
    Sum nm :: 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
$ (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 "sum" Identifier
nm HWType
t)
    CustomSum nm :: 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
$ (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 "sum" Identifier
nm HWType
t)
    SP nm :: 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
$ (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 "sp" Identifier
nm HWType
t)
    CustomSP nm :: 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
$ (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 "sp" Identifier
nm HWType
t)
    Product nm :: 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
$ (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 "product" Identifier
nm HWType
t)
    CustomProduct nm :: 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
$ (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 "product" Identifier
nm HWType
t)
    Annotated _ hwTy :: HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 HWType
hwTy
    BiDirectional _ hwTy :: HWType
hwTy ->
      HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 HWType
hwTy
    FileType -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return "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 hwty :: HWType
hwty = case HWType
hwty of
  Void {} -> HWType
hwty
  KnownDomain {} -> HWType
hwty

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

  -- Complex types, for which a user defined type is made in VHDL:
  Vector _ _    -> HWType
hwty
  RTree _ _     -> HWType
hwty
  Product _ _ _ -> HWType
hwty

  -- Simple types, for which a subtype (without qualifiers) will be made in VHDL:
  Clock _           -> HWType
Bit
  Reset _           -> HWType
Bit
  Index _           -> Int -> HWType
Unsigned (HWType -> Int
typeSize HWType
hwty)
  CustomSP _ _ _ _  -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  SP _ _            -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  Sum _ _           -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  CustomSum _ _ _ _ -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
  CustomProduct {}  -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)

  -- Transparent types:
  Annotated _ elTy :: HWType
elTy -> HWType -> HWType
normaliseType HWType
elTy
  BiDirectional _ elTy :: HWType
elTy -> HWType -> HWType
normaliseType HWType
elTy

-- | Recursively remove transparent types from given type
filterTransparent :: HWType -> HWType
filterTransparent :: HWType -> HWType
filterTransparent hwty :: HWType
hwty = case HWType
hwty of
  Bool              -> HWType
hwty
  Signed _          -> HWType
hwty
  Unsigned _        -> HWType
hwty
  BitVector _       -> HWType
hwty
  String            -> HWType
hwty
  Integer           -> HWType
hwty
  Bit               -> HWType
hwty
  Clock _           -> HWType
hwty
  Reset _           -> HWType
hwty
  Index _           -> HWType
hwty
  Sum _ _           -> HWType
hwty
  CustomSum _ _ _ _ -> HWType
hwty
  FileType          -> HWType
hwty

  Vector n :: Int
n elTy :: HWType
elTy     -> Int -> HWType -> HWType
Vector Int
n (HWType -> HWType
filterTransparent HWType
elTy)
  RTree n :: Int
n elTy :: HWType
elTy      -> Int -> HWType -> HWType
RTree Int
n (HWType -> HWType
filterTransparent HWType
elTy)
  Product nm :: Identifier
nm labels :: Maybe [Identifier]
labels elTys :: [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 nm0 :: Identifier
nm0 constrs :: [(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 (\(nm1 :: Identifier
nm1, tys :: [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 nm0 :: Identifier
nm0 drepr :: DataRepr'
drepr size :: Int
size constrs :: [(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 (\(repr :: ConstrRepr'
repr, nm1 :: Identifier
nm1, tys :: [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 nm0 :: Identifier
nm0 drepr :: DataRepr'
drepr size :: Int
size maybeFieldNames :: Maybe [Identifier]
maybeFieldNames constrs :: [(FieldAnn, HWType)]
constrs ->
    Identifier
-> DataRepr'
-> Int
-> Maybe [Identifier]
-> [(FieldAnn, HWType)]
-> HWType
CustomProduct Identifier
nm0 DataRepr'