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

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

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

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


-- | Convert a Netlist HWType to an error VHDL value for that type
sizedQualTyNameErrValue :: HWType -> VHDLM Doc
sizedQualTyNameErrValue :: HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue Bool                = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Just (Just 0) -> "false"
    _             -> "true"
sizedQualTyNameErrValue Bit                 = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue t :: HWType
t@(Vector n :: Int
n elTy :: HWType
elTy)   = do
  HdlSyn
syn <-State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
<+> "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) Mon (State VHDLState) Doc
-> 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
<+>
                "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
<+> "to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                 Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue))
    _ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
<+> "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) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(RTree n :: Int
n elTy :: HWType
elTy)    = do
  HdlSyn
syn <-State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
<+> "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
n 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
<+> 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
<+>
                "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
<+> "to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
                 Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue))
    _ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
<+> "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
n 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
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(Product _ _ elTys :: [HWType]
elTys) =
  HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((HWType -> Mon (State VHDLState) Doc)
-> [HWType] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue [HWType]
elTys)
sizedQualTyNameErrValue (Reset {}) = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Clock _)  = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Void {})  =
  Doc -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Doc
forall a. HasCallStack => String -> a
error ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "[CLASH BUG] Forced to print Void error value"))
sizedQualTyNameErrValue String              = "\"ERROR\""
sizedQualTyNameErrValue t :: HWType
t =
  HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
<+> "to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue)

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

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

decls :: [Declaration] -> VHDLM Doc
decls :: [Declaration] -> Mon (State VHDLState) Doc
decls [] = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
decls ds :: [Declaration]
ds = do
    rec (dsDoc :: [Doc]
dsDoc,ls :: [Int]
ls) <- ([Maybe (Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [Maybe (Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Doc, Int)] -> ([Doc], [Int]))
-> ([Maybe (Doc, Int)] -> [(Doc, Int)])
-> [Maybe (Doc, Int)]
-> ([Doc], [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Doc, Int)] -> [(Doc, Int)]
forall a. [Maybe a] -> [a]
catMaybes) (Mon (State VHDLState) [Maybe (Doc, Int)]
 -> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [Maybe (Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ (Declaration -> Mon (State VHDLState) (Maybe (Doc, Int)))
-> [Declaration] -> Mon (State VHDLState) [Maybe (Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Declaration -> Mon (State VHDLState) (Maybe (Doc, Int))
decl ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls)) [Declaration]
ds
    case [Doc]
dsDoc of
      [] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      _  -> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (m :: Type -> Type).
Monad m =>
Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
dsDoc)

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

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

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

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

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

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

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

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

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

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

insts :: [Declaration] -> VHDLM Doc
insts :: [Declaration] -> Mon (State VHDLState) Doc
insts [] = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl id_ :: Identifier
id_:ds :: [Declaration]
ds) = Identifier -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
Identifier -> Identifier -> f Doc
comment "--" Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
insts (d :: Declaration
d:ds :: [Declaration]
ds) = do
  Maybe Doc
d' <- Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
d' of
    Just doc :: Doc
doc -> Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
    _ -> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds

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

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

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

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

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

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

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

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

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

inst_ (InstDecl entOrComp :: EntityOrComponent
entOrComp libM :: Maybe Identifier
libM nm :: Identifier
nm lbl :: Identifier
lbl gens :: [(Expr, HWType, Expr)]
gens pms :: [(Expr, PortDirection, HWType, Expr)]
pms) = do
    Mon (State VHDLState) ()
-> (Identifier -> Mon (State VHDLState) ())
-> Maybe Identifier
-> Mon (State VHDLState) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Mon (State VHDLState) ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) (\lib :: Identifier
lib -> State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Identifier -> Text
T.fromStrict Identifier
libText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))) Maybe Identifier
libM
    (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
      Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest 2 (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
lbl Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
entOrComp'
                Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
-> (Identifier -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc ((Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> ".") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Identifier -> Mon (State VHDLState) Doc)
-> Identifier
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
libM Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
gms Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
pms' Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
  where
    gms :: Mon (State VHDLState) Doc
gms | [] <- [(Expr, HWType, Expr)]
gens = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
        | Bool
otherwise =  do
      rec (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 (Mon (State VHDLState) [(Doc, Int)]
 -> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (,Expr -> Int
forall p. Num p => Expr -> p
formalLength Expr
i) (Doc -> (Doc, Int))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
i) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "=>" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e | (i :: Expr
i,_,e :: Expr
e) <- [(Expr, HWType, Expr)]
gens]
      Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest 2 ("generic map" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
    pms' :: Mon (State VHDLState) Doc
pms' = do
      rec (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 (Mon (State VHDLState) [(Doc, Int)]
 -> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (,Expr -> Int
forall p. Num p => Expr -> p
formalLength Expr
i) (Doc -> (Doc, Int))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
i) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "=>" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e | (i :: Expr
i,_,_,e :: Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms]
      Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest 2 (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ "port map" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p)
    formalLength :: Expr -> p
formalLength (Identifier i :: Identifier
i _) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Identifier -> Int
TextS.length Identifier
i)
    formalLength _                = 0
    entOrComp' :: Mon (State VHDLState) Doc
entOrComp' = case EntityOrComponent
entOrComp of { Entity -> " entity"; Comp -> " component"; Empty -> ""}

inst_ (BlackBoxD _ libs :: [BlackBoxTemplate]
libs imps :: [BlackBoxTemplate]
imps inc :: [((Identifier, Identifier), BlackBox)]
inc bs :: BlackBox
bs bbCtx :: BlackBoxContext
bbCtx) =
  (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (State VHDLState Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT VHDLState Identity (Int -> Doc) -> State VHDLState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx)))

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

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

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

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

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

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

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

-- | Turn a Netlist expression into a VHDL expression
expr_
  :: HasCallStack
  => Bool
  -- ^ Enclose in parentheses?
  -> Expr
  -- ^ Expr to convert
  -> VHDLM Doc
expr_ :: Bool -> Expr -> Mon (State VHDLState) Doc
expr_ _ (Literal sizeM :: Maybe (HWType, Int)
sizeM lit :: Literal
lit) = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
sizeM Literal
lit
expr_ _ (Identifier id_ :: Identifier
id_ Nothing) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (CustomSP _id :: Identifier
_id dataRepr :: DataRepr'
dataRepr _size :: Int
_size args :: [(ConstrRepr', Identifier, [HWType])]
args,dcI :: Int
dcI,fI :: Int
fI)))) =
  case HWType
fieldTy of
    Void {} ->
      String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    _ -> 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
      let cast :: Mon (State VHDLState) Doc
cast = HWType -> Mon (State VHDLState) Doc
qualTyName HWType
resultType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote
      let fSLV :: Mon (State VHDLState) Doc
fSLV = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS (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
cast Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
fSLV Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate " & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) [Doc]
ranges))
 where
  resultType :: HWType
resultType = [HWType]
fieldTypes [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
  (ConstrRepr' _name :: Identifier
_name _n :: Int
_n _mask :: FieldAnn
_mask _value :: FieldAnn
_value anns :: [FieldAnn]
anns, _, fieldTypes :: [HWType]
fieldTypes) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI

  ranges :: Mon (State VHDLState) [Doc]
ranges =
    ((Int, Int) -> Mon (State VHDLState) Doc)
-> [(Int, Int)] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, Int) -> Mon (State VHDLState) Doc
range ([(Int, Int)] -> Mon (State VHDLState) [Doc])
-> [(Int, Int)] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ FieldAnn -> [(Int, Int)]
bitRanges ([FieldAnn]
anns [FieldAnn] -> Int -> FieldAnn
forall a. [a] -> Int -> a
!! Int
fI)

  range :: (Int, Int) -> Mon (State VHDLState) Doc
range (start :: Int
start, end :: Int
end) =
    Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

  fieldTy :: HWType
fieldTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "panic") [HWType]
fieldTypes Int
fI

expr_ b :: Bool
b (Identifier id_ :: Identifier
id_ (Just (Indexed (ty :: HWType
ty@(SP _ args :: [(Identifier, [HWType])]
args),dcI :: Int
dcI,fI :: Int
fI)))) = do
  Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
  case Bool
b of
    True ->
      (case HWType -> HWType
normaliseType HWType
argTy of
        BitVector {} -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. a -> a
id
        _ -> (\x :: Mon (State VHDLState) Doc
x -> 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 Mon (State VHDLState) Doc
x))
      (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
    _ -> HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
argTy Identifier
id_ Int
start Int
end
 where
   argTys :: [HWType]
argTys   = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])]
args [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
dcI
   argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. [a] -> Int -> a
!! Int
fI
   argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
   other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
   start :: Int
start    = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
   end :: Int
end      = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (CustomProduct _ dataRepr :: DataRepr'
dataRepr _ _ tys :: [(FieldAnn, HWType)]
tys, dcI :: Int
dcI, fI :: Int
fI)))) =
  case HWType
fieldTy of
    Void {} ->
      String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    _ -> do
      Identifier
modNm' <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm)
      let cast :: Mon (State VHDLState) Doc
cast = HWType -> Mon (State VHDLState) Doc
qualTyName HWType
fieldTy Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote
      let fSLV :: Mon (State VHDLState) Doc
fSLV = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS (Identifier -> Identifier
TextS.toLower Identifier
modNm') 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
cast Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. 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
fSLV Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate " & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) [Doc]
ranges))
 where
  (fieldAnn :: FieldAnn
fieldAnn, fieldTy :: HWType
fieldTy) = String -> [(FieldAnn, HWType)] -> Int -> (FieldAnn, HWType)
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "panic") [(FieldAnn, HWType)]
tys Int
fI
  ranges :: Mon (State VHDLState) [Doc]
ranges = ((Int, Int) -> Mon (State VHDLState) Doc)
-> [(Int, Int)] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, Int) -> Mon (State VHDLState) Doc
range (FieldAnn -> [(Int, Int)]
bitRanges FieldAnn
fieldAnn)
  range :: (Int, Int) -> Mon (State VHDLState) Doc
range (start :: Int
start, end :: Int
end) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (ty :: HWType
ty@(Product _ labels :: Maybe [Identifier]
labels tys :: [HWType]
tys),_,fI :: Int
fI)))) =
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) Doc
tyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
fI

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Vector _ elTy :: HWType
elTy),1,0)))) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    Vivado -> do
      Identifier
id' <- (Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> 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))
      HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy Identifier
id' (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 0
    _ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int 0)
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Vector n :: Int
n _),1,1)))) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int 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" 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))

-- This is a "Hack", we cannot construct trees with a negative depth. This is
-- here so that we can recognise merged RTree modifiers. See the code in
-- @Clash.Backend.nestM@ which construct these tree modifiers.
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed (RTree (-1) _,l :: Int
l,r :: Int
r)))) =
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
l 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
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-1))

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree 0 elTy :: HWType
elTy),0,0)))) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    Vivado -> do
      Identifier
id' <- (Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> 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))
      HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy Identifier
id' (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 0
    _ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int 0)
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree n :: Int
n _),1,0)))) =
  let z :: Int
z = 2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
  in  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int 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
<+> "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
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-1))
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree n :: Int
n _),1,1)))) =
  let z :: Int
z  = 2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
      z' :: Int
z' = 2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n
  in  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
z 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
z'Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))

-- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Vector _ elTy :: HWType
elTy),10,fI :: Int
fI)))) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    Vivado -> do
      Identifier
id' <- (Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> 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
fI))
      HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy Identifier
id' (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 0
    _ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI)

-- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((RTree _ elTy :: HWType
elTy),10,fI :: Int
fI)))) = do
  HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    Vivado -> do
      Identifier
id' <- (Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> 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
fI))
      HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy Identifier
id' (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 0
    _ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI)

expr_ _ (Identifier id_ :: Identifier
id_ (Just (DC (ty :: HWType
ty@(SP _ _),_)))) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
  where
    start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
    end :: Int
end   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty

-- [Note] integer projection
--
-- The idea behind these expressions is to translate cases like:
--
-- > :: Int8 -> Int#
-- > \case I8# i -> i
--
-- Which is fine, because no bits are lost. However, these expression might
-- also be the result of the W/W transformation (or uses of unsafeToInteger)
-- for:
--
-- > :: Signed 128 -> Integer
-- > \case S i -> i
--
-- which is very bad because `Integer` is represented by 64 bits meaning we
-- we lose the top 64 bits in the above translation.
--
-- Just as bad is that
--
-- > :: Word8 -> Word#
-- > \case W8# w -> w
--
-- > :: Unsigned 8 -> Integer
-- > \case U i -> i
--
-- result in the same expression... even though their resulting types are
-- different. TODO: this needs  to be fixed!
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Signed w :: Int
w),_,_))))  = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    "resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((Unsigned w :: Int
w),_,_)))) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    "resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)

-- [Note] mask projection
--
-- This covers the case of either:
--
-- `Clash.Sized.Internal.BitVector.unsafeToMask` or
--
-- > :: BitVector 8 -> Integer
-- > \case BV m wild -> m
--
-- introduced by the W/W transformation. Both of which we prefer not to see
-- but will allow. Since the mask is pretty much a simulation artifact we
-- emit don't cares so stuff gets optimised away.
expr_ _ (Identifier _ (Just (Indexed ((BitVector _),_,0)))) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf Bool
True ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "WARNING: synthesizing bitvector mask to dontcare") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue (Int -> HWType
Signed Int
iw)

-- [Note] bitvector projection
--
-- This covers the case of either:
--
-- `Clash.Sized.Internal.BitVector.unsafeToInteger` or
--
-- > :: BitVector 8 -> Integer
-- > \case BV wild i -> i
--
-- introduced by the
expr_ _ (Identifier id_ :: Identifier
id_ (Just (Indexed ((BitVector w :: Int
w),_,1)))) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
    "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 ("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 ("resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
      Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ("unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))

expr_ _ (Identifier id_ :: Identifier
id_ (Just (Sliced (BitVector _,start :: Int
start,end :: Int
end)))) =
  Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

expr_ b :: Bool
b (Identifier id_ :: Identifier
id_ (Just (Nested (Indexed ((Vector n :: Int
n elTy :: HWType
elTy),1,1)) m0 :: Modifier
m0))) = Int -> Modifier -> Mon (State VHDLState) Doc
go 1 Modifier
m0
 where
  go :: Int -> Modifier -> Mon (State VHDLState) Doc
go s :: Int
s (Nested (Indexed ((Vector {}),1,1)) m1 :: Modifier
m1) = Int -> Modifier -> Mon (State VHDLState) Doc
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Modifier
m1
  go s :: Int
s (Indexed (Vector {},1,1)) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
sInt -> 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
<+> "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))
  go s :: Int
s (Indexed (Vector {},1,0)) = do
    HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    case HdlSyn
syn of
      Vivado -> do
        Identifier
id' <- (Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> 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))
        HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy Identifier
id' (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 0
      _ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s)
  -- This is a HACK for Clash.Driver.TopWrapper.mkOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
  go s :: Int
s (Indexed (Vector {},10,fI :: Int
fI)) = do
    HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    case HdlSyn
syn of
      Vivado -> do
        Identifier
id' <- (Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> 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
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI)))
        HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy Identifier
id' (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 0
      _ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI))
  go s :: Int
s m1 :: Modifier
m1 = do
    Doc
k <- Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1))
    Bool -> Expr -> Mon (State VHDLState) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
b (Identifier -> Maybe Modifier -> Expr
Identifier (Text -> Identifier
T.toStrict (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ Doc -> Text
forall ann. Doc ann -> Text
renderOneLine Doc
k) (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just Modifier
m1))

expr_ b :: Bool
b (Identifier id_ :: Identifier
id_ (Just (Nested m1 :: Modifier
m1 m2 :: Modifier
m2))) = case Modifier -> Modifier -> Maybe Modifier
nestM Modifier
m1 Modifier
m2 of
  Just m3 :: Modifier
m3 -> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
b (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
id_ (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just Modifier
m3))
  _ -> do
    Doc
k <- HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
id_ (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just Modifier
m1))
    HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
b (Identifier -> Maybe Modifier -> Expr
Identifier (Text -> Identifier
T.toStrict (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ Doc -> Text
forall ann. Doc ann -> Text
renderOneLine Doc
k) (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just Modifier
m2))

expr_ _ (Identifier id_ :: Identifier
id_ (Just _)) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_

expr_ b :: Bool
b (DataCon _ (DC (Void {}, -1)) [e :: Expr
e]) =  HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
b Expr
e

expr_ _ (DataCon ty :: HWType
ty@(Vector 0 _) _ _) = HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
ty

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

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

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

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

expr_ _ (DataCon ty :: HWType
ty@(Sum _ _) (DC (_,i :: Int
i)) []) =
  HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
expr_ _ (DataCon ty :: HWType
ty@(CustomSum _ _ _ tys :: [(ConstrRepr', Identifier)]
tys) (DC (_,i :: Int
i)) []) =
  let (ConstrRepr' _ _ _ value :: FieldAnn
value _) = (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
tys [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i in
  "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 ("to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldAnn
value) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty)))
expr_ _ (DataCon (CustomSP _ dataRepr :: DataRepr'
dataRepr _size :: Int
_size args :: [(ConstrRepr', Identifier, [HWType])]
args) (DC (_,i :: Int
i)) es :: [Expr]
es) =
  let (cRepr :: ConstrRepr'
cRepr, _, argTys :: [HWType]
argTys) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
i in
  DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
argTys [Expr]
es)
expr_ _ (DataCon (CustomProduct _ dataRepr :: DataRepr'
dataRepr _size :: Int
_size _labels :: Maybe [Identifier]
_labels tys :: [(FieldAnn, HWType)]
tys) _ es :: [Expr]
es) |
  DataRepr' _typ :: Type'
_typ _size :: Int
_size [cRepr :: ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((FieldAnn, HWType) -> HWType) -> [(FieldAnn, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd [(FieldAnn, HWType)]
tys) [Expr]
es)

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

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Signed.fromInteger#"
  , [Literal _ (NumLit n :: FieldAnn
n), Literal _ i :: Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) Literal
i

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Unsigned.fromInteger#"
  , [Literal _ (NumLit n :: FieldAnn
n), Literal _ i :: Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) Literal
i

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#"
  , [Literal _ (NumLit n :: FieldAnn
n), Literal _ m :: Literal
m, Literal _ i :: Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = let NumLit m' :: FieldAnn
m' = Literal
m
        NumLit i' :: FieldAnn
i' = Literal
i
    in Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) (FieldAnn -> FieldAnn -> Literal
BitVecLit FieldAnn
m' FieldAnn
i')

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger##"
  , [Literal _ m :: Literal
m, Literal _ i :: Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = let NumLit m' :: FieldAnn
m' = Literal
m
        NumLit i' :: FieldAnn
i' = Literal
i
    in Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bit,1)) (Bit -> Literal
BitLit (Bit -> Literal) -> Bit -> Literal
forall a b. (a -> b) -> a -> b
$ FieldAnn -> FieldAnn -> Bit
toBit FieldAnn
m' FieldAnn
i')

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

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

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "GHC.Types.I#"
  , [Literal _ (NumLit n :: FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = do Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
       Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed Int
iw,Int
iw)) (FieldAnn -> Literal
NumLit FieldAnn
n)

expr_ _ (BlackBoxE pNm :: Identifier
pNm _ _ _ _ bbCtx :: BlackBoxContext
bbCtx _)
  | Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== "GHC.Types.W#"
  , [Literal _ (NumLit n :: FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = do Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
       Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
iw,Int
iw)) (FieldAnn -> Literal
NumLit FieldAnn
n)

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

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

expr_ _ (DataTag hty :: HWType
hty@(Sum _ _) (Left id_ :: Identifier
id_)) =
  "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 ("resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ("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 ("std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
hty)))
expr_ _ (DataTag (Sum _ _) (Right id_ :: Identifier
id_)) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  "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 ("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 ("resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ("unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))

expr_ _ (DataTag (Product {}) (Right _))  = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  "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
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ _ (DataTag hty :: HWType
hty@(SP _ _) (Right id_ :: Identifier
id_)) = do {
    ; Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
    ; "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 ("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 (
      "resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ("unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
                          Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))
    }
  where
    start :: Int
start = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
    end :: Int
end   = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
hty

expr_ _ (DataTag (Vector 0 _) (Right _)) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  "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
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ _ (DataTag (Vector _ _) (Right _)) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  "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
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)

expr_ _ (DataTag (RTree 0 _) (Right _)) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  "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
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ _ (DataTag (RTree _ _) (Right _)) = do
  Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
  "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
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)

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

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

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

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

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

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

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

exprLit (Just (hty :: HWType
hty,sz :: Int
sz)) (NumLit i :: FieldAnn
i) = case HWType
hty of
  Unsigned n :: Int
n
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< (-2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(31 :: Integer)) -> "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 ("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 ("signed'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit))
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< 0                    -> "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 ("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 ("to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens(FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)))
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< 2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(31 :: Integer) -> "to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
    | Bool
otherwise -> "unsigned'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
  Signed n :: Int
n
    | FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< 2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(31 :: Integer) Bool -> Bool -> Bool
&& FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
> (-2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(31 :: Integer)) -> "to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
    | Bool
otherwise -> "signed'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
  BitVector _ -> "std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
  Bit         -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 2))
  _           -> Mon (State VHDLState) Doc
blit

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

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


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

patLit :: HWType -> Literal -> VHDLM Doc
patLit :: HWType -> Literal -> Mon (State VHDLState) Doc
patLit Bit (NumLit i :: FieldAnn
i) = if FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "'0'" else "'1'"
patLit hwTy :: HWType
hwTy (NumLit i :: FieldAnn
i) =
  let sz :: Int
sz = HWType -> Int
conSize HWType
hwTy
  in  case Int
sz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4 of
        0 -> String -> Mon (State VHDLState) Doc
hex  (Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i)
        _ -> [Bit] -> Mon (State VHDLState) Doc
bits (Int -> FieldAnn -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz FieldAnn
i)
patLit _    l :: Literal
l          = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
l

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

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

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

bits :: [Bit] -> VHDLM Doc
bits :: [Bit] -> Mon (State VHDLState) Doc
bits = Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> ([Bit] -> Mon (State VHDLState) Doc)
-> [Bit]
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> ([Bit] -> Mon (State VHDLState) [Doc])
-> [Bit]
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Mon (State VHDLState) Doc)
-> [Bit] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Bit -> Mon (State VHDLState) Doc
bit_char

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

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

bit_char :: Bit -> VHDLM Doc
bit_char :: Bit -> Mon (State VHDLState) Doc
bit_char H = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char '1'
bit_char L = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char '0'
bit_char U = do
  Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Nothing -> Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char '-'
    Just Nothing -> Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char '0'
    Just (Just i :: Int
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 Int
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> "'"
bit_char Z = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char 'Z'

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

fromSLV :: HasCallStack => HWType -> Identifier -> Int -> Int -> VHDLM Doc
fromSLV :: HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV Bool              id_ :: Identifier
id_ start :: Int
start _   = 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 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start))
fromSLV Bit                 id_ :: Identifier
id_ start :: Int
start _   = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start)
fromSLV (BitVector _)       id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fromSLV (Index _)           id_ :: Identifier
id_ start :: Int
start end :: Int
end = "unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
fromSLV (Signed _)          id_ :: Identifier
id_ start :: Int
start end :: Int
end = "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 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
fromSLV (Unsigned _)        id_ :: Identifier
id_ start :: Int
start end :: Int
end = "unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
fromSLV (Sum _ _)           id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fromSLV (CustomSum _ _ _ _) id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fromSLV t :: HWType
t@(Product _ labels :: Maybe [Identifier]
labels tys :: [HWType]
tys) id_ :: Identifier
id_ start :: Int
start _ = do
    Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (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 (\s :: Mon (State VHDLState) Doc
s e :: Mon (State VHDLState) Doc
e -> Mon (State VHDLState) Doc
s Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
e) [Mon (State VHDLState) Doc]
selNames [Mon (State VHDLState) Doc]
args
  where
    tName :: Mon (State VHDLState) Doc
tName      = HWType -> Mon (State VHDLState) Doc
tyName HWType
t
    selNames :: [Mon (State VHDLState) Doc]
selNames   = [Mon (State VHDLState) Doc
tName Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
i | Int
i <- [0..]]
    argLengths :: [Int]
argLengths = (HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
tys
    starts :: [Int]
starts     = Int
start 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
start [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
+1) ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
starts)
    args :: [Mon (State VHDLState) Doc]
args       = (HWType -> Int -> Int -> Mon (State VHDLState) Doc)
-> [HWType] -> [Int] -> [Int] -> [Mon (State VHDLState) Doc]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
`fromSLV` Identifier
id_) [HWType]
tys [Int]
starts [Int]
ends

fromSLV (CustomSP _ _ _ _)  id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fromSLV (CustomProduct {})  id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fromSLV (SP _ _)            id_ :: Identifier
id_ start :: Int
start end :: Int
end = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> "downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
fromSLV (Vector n :: Int
n elTy :: HWType
elTy)     id_ :: Identifier
id_ start :: Int
start _   =
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled Mon (State VHDLState) [Doc]
args
             else 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
<+> ([Doc] -> Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> Doc
forall a. [a] -> a
head Mon (State VHDLState) [Doc]
args)
  where
    argLength :: Int
argLength = HWType -> Int
typeSize HWType
elTy
    starts :: [Int]
starts    = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
argLength) Int
start
    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
+1) ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
starts)
    args :: Mon (State VHDLState) [Doc]
args      = 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 elTy' :: HWType
elTy' = case HdlSyn
syn of
                                 Vivado -> Int -> HWType
BitVector (Int
argLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
                                 _ -> HWType
elTy
                   (Int -> Int -> Mon (State VHDLState) Doc)
-> [Int] -> [Int] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (HasCallStack =>
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
HWType -> Identifier -> Int -> Int -> Mon (State VHDLState) Doc
fromSLV HWType
elTy' Identifier
id_) [Int]
starts [Int]
ends
fromSLV (Clock {})        id_ :: Identifier
id_ start :: Int
start _   = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start)
fromSLV (Reset {})        id_ :: Identifier
id_ start :: Int
start _   = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start)
fromSLV hty :: HWType
hty               _   _     _   = 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]
++ "fromSLV: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
hty

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

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

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

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

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

encodingNote :: HWType -> VHDLM Doc
encodingNote :: HWType -> Mon (State VHDLState) Doc
encodingNote (Clock _)  = "-- clock" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (Reset _ ) = "-- reset" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote _          = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

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