{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Clash.Backend.VHDL (VHDLState) where
import Control.Arrow (second)
import Control.Applicative (liftA2)
import Control.Lens hiding (Indexed, Empty)
import Control.Monad (forM,join,zipWithM)
import Control.Monad.State (State, StateT)
import Data.Bits (testBit, Bits)
import Data.Hashable (Hashable)
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.HashMap.Strict as HashMapS
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List
(mapAccumL, nub, nubBy, intersperse, group, sort)
import Data.List.Extra ((<:>), equalLength)
import Data.Maybe (catMaybes,fromMaybe,mapMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid hiding (Sum, Product)
#endif
import Data.Semigroup.Monad.Extra
import qualified Data.Text.Lazy as T
import qualified Data.Text as TextS
import qualified Data.Text.Prettyprint.Doc as PP
import Data.Text.Prettyprint.Doc.Extra
import GHC.Stack (HasCallStack)
import qualified System.FilePath
import Text.Printf
import TextShow (showt)
import Clash.Annotations.Primitive (HDL (..))
import Clash.Annotations.BitRepresentation.Internal
(ConstrRepr'(..), DataRepr'(..))
import Clash.Annotations.BitRepresentation.ClashLib
(bitsToBits)
import Clash.Annotations.BitRepresentation.Util
(BitOrigin(Lit, Field), bitOrigins, bitRanges)
import Clash.Backend
import Clash.Core.Var (Attr'(..),attrName)
import Clash.Debug (traceIf)
import Clash.Netlist.BlackBox.Types (HdlSyn (..))
import Clash.Netlist.BlackBox.Util
(extractLiterals, renderBlackBox, renderFilePath)
import Clash.Netlist.Id (IdType (..), mkBasicId')
import Clash.Netlist.Types hiding (_intWidth, intWidth)
import Clash.Netlist.Util hiding (mkIdentifier)
import Clash.Util
(SrcSpan, noSrcSpan, clogBase, curLoc, first, makeCached, on, indexNote)
import Clash.Util.Graph (reverseTopSort)
import Clash.Backend.Verilog (Range (..), continueWithRange)
data VHDLState =
VHDLState
{ VHDLState -> HashSet HWType
_tyCache :: (HashSet HWType)
, VHDLState -> HashMap Identifier Word
_tySeen :: HashMap Identifier Word
, VHDLState -> HashMap (HWType, Bool) Identifier
_nameCache :: (HashMap (HWType, Bool) TextS.Text)
, 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)]
, VHDLState -> [(String, String)]
_memoryDataFiles:: [(String,String)]
, VHDLState -> HashMap Identifier Word
_idSeen :: HashMapS.HashMap Identifier Word
, VHDLState -> Int
_intWidth :: Int
, VHDLState -> HdlSyn
_hdlsyn :: HdlSyn
, VHDLState -> Bool
_extendedIds :: Bool
, VHDLState -> Maybe (Maybe Int)
_undefValue :: Maybe (Maybe Int)
}
makeLenses ''VHDLState
instance Backend VHDLState where
initBackend :: Int -> HdlSyn -> Bool -> Maybe (Maybe Int) -> VHDLState
initBackend = HashSet HWType
-> HashMap Identifier Word
-> HashMap (HWType, Bool) Identifier
-> Identifier
-> SrcSpan
-> [Text]
-> [Text]
-> [(String, Doc)]
-> [(String, String)]
-> [(String, String)]
-> HashMap Identifier Word
-> Int
-> HdlSyn
-> Bool
-> Maybe (Maybe Int)
-> VHDLState
VHDLState HashSet HWType
forall a. HashSet a
HashSet.empty HashMap Identifier Word
forall k v. HashMap k v
HashMap.empty HashMap (HWType, Bool) Identifier
forall k v. HashMap k v
HashMap.empty Identifier
""
SrcSpan
noSrcSpan [] [] [] [] [] HashMap Identifier Word
forall k v. HashMap k v
HashMapS.empty
hdlKind :: VHDLState -> HDL
hdlKind = HDL -> VHDLState -> HDL
forall a b. a -> b -> a
const HDL
VHDL
primDirs :: VHDLState -> IO [String]
primDirs = IO [String] -> VHDLState -> IO [String]
forall a b. a -> b -> a
const (IO [String] -> VHDLState -> IO [String])
-> IO [String] -> VHDLState -> IO [String]
forall a b. (a -> b) -> a -> b
$ do String
root <- IO String
primsRoot
[String] -> IO [String]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ String
root String -> String -> String
System.FilePath.</> String
"common"
, String
root String -> String -> String
System.FilePath.</> String
"vhdl"
]
extractTypes :: VHDLState -> HashSet HWType
extractTypes = VHDLState -> HashSet HWType
_tyCache
name :: VHDLState -> String
name = String -> VHDLState -> String
forall a b. a -> b -> a
const String
"vhdl"
extension :: VHDLState -> String
extension = String -> VHDLState -> String
forall a b. a -> b -> a
const String
".vhdl"
genHDL :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genHDL = Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL
mkTyPackage :: Identifier -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage = Identifier -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage_
hdlType :: Usage -> HWType -> Mon (State VHDLState) Doc
hdlType Usage
Internal (HWType -> HWType
filterTransparent -> HWType
ty) = HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
ty
hdlType (External Identifier
nm) (HWType -> HWType
filterTransparent -> HWType
ty) =
let sized :: Mon (State VHDLState) Doc
sized = HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
ty in
case HWType
ty of
HWType
Bit -> Mon (State VHDLState) Doc
sized
HWType
Bool -> Mon (State VHDLState) Doc
sized
Signed Int
_ -> Mon (State VHDLState) Doc
sized
Unsigned Int
_ -> Mon (State VHDLState) Doc
sized
BitVector Int
_ -> Mon (State VHDLState) Doc
sized
HWType
_ -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
sized
hdlTypeErrValue :: HWType -> Mon (State VHDLState) Doc
hdlTypeErrValue = HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue
hdlTypeMark :: HWType -> Mon (State VHDLState) Doc
hdlTypeMark = HWType -> Mon (State VHDLState) Doc
qualTyName
hdlRecSel :: HWType -> Int -> Mon (State VHDLState) Doc
hdlRecSel = HWType -> Int -> Mon (State VHDLState) Doc
vhdlRecSel
hdlSig :: Text -> HWType -> Mon (State VHDLState) Doc
hdlSig Text
t HWType
ty = Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
sigDecl (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
t) HWType
ty
genStmt :: Bool -> State VHDLState Doc
genStmt = State VHDLState Doc -> Bool -> State VHDLState Doc
forall a b. a -> b -> a
const State VHDLState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
inst :: Declaration -> Mon (State VHDLState) (Maybe Doc)
inst = Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_
expr :: Bool -> Expr -> Mon (State VHDLState) Doc
expr = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_
iwWidth :: State VHDLState Int
iwWidth = Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
toBV :: HWType -> Text -> Mon (State VHDLState) Doc
toBV HWType
t Text
id_
| HWType -> Bool
isBV HWType
t = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_
| Bool
otherwise = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
HashMap Identifier Word
seen <- Getting
(HashMap Identifier Word) VHDLState (HashMap Identifier Word)
-> Mon (State VHDLState) (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
(HashMap Identifier Word) VHDLState (HashMap Identifier Word)
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
seenIdentifiers
let e :: Mon (State VHDLState) Doc
e | Text -> Identifier
T.toStrict Text
id_ Identifier -> HashMap Identifier Word -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMapS.member` HashMap Identifier Word
seen = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_
| Bool
otherwise = HWType -> Mon (State VHDLState) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeMark HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
e
fromBV :: HWType -> Text -> Mon (State VHDLState) Doc
fromBV HWType
t Text
id_
| HWType -> Bool
isBV HWType
t = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_
| Bool
otherwise = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_))
hdlSyn :: State VHDLState HdlSyn
hdlSyn = Getting HdlSyn VHDLState HdlSyn -> State VHDLState HdlSyn
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting HdlSyn VHDLState HdlSyn
Lens' VHDLState HdlSyn
hdlsyn
mkIdentifier :: State VHDLState (IdType -> Identifier -> Identifier)
mkIdentifier = do
Bool
allowExtended <- Getting Bool VHDLState Bool -> StateT VHDLState Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool VHDLState Bool
Lens' VHDLState Bool
extendedIds
(IdType -> Identifier -> Identifier)
-> State VHDLState (IdType -> Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> IdType -> Identifier -> Identifier
go Bool
allowExtended)
where
go :: Bool -> IdType -> Identifier -> Identifier
go Bool
_ IdType
Basic Identifier
nm =
case (Identifier -> Identifier
stripTrailingUnderscore (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
filterReserved) (Identifier -> Identifier
TextS.toLower (HDL -> Bool -> Identifier -> Identifier
mkBasicId' HDL
VHDL Bool
True Identifier
nm)) of
Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> Identifier
"clash_internal"
| Bool
otherwise -> Identifier
nm'
go Bool
esc IdType
Extended (Identifier -> Identifier
rmSlash -> Identifier
nm) = case Bool -> IdType -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm of
Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nm' -> [Identifier] -> Identifier
TextS.concat [Identifier
"\\",Identifier
nm,Identifier
"\\"]
| Bool
otherwise -> Identifier
nm'
extendIdentifier :: State VHDLState (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier = do
Bool
allowExtended <- Getting Bool VHDLState Bool -> StateT VHDLState Identity Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool VHDLState Bool
Lens' VHDLState Bool
extendedIds
(IdType -> Identifier -> Identifier -> Identifier)
-> State
VHDLState (IdType -> Identifier -> Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
allowExtended)
where
go :: Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
_ IdType
Basic Identifier
nm Identifier
ext =
case (Identifier -> Identifier
stripTrailingUnderscore (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
filterReserved) (Identifier -> Identifier
TextS.toLower (HDL -> Bool -> Identifier -> Identifier
mkBasicId' HDL
VHDL Bool
True (Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext))) of
Identifier
nm' | Identifier -> Bool
TextS.null Identifier
nm' -> Identifier
"clash_internal"
| Bool
otherwise -> Identifier
nm'
go Bool
esc IdType
Extended ((Identifier -> Identifier
rmSlash (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
escapeTemplate) -> Identifier
nm) Identifier
ext =
let nmExt :: Identifier
nmExt = Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
ext
in case Bool -> IdType -> Identifier -> Identifier -> Identifier
go Bool
esc IdType
Basic Identifier
nm Identifier
ext of
Identifier
nm' | Bool
esc Bool -> Bool -> Bool
&& Identifier
nm' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
nmExt -> case Identifier -> Identifier -> Bool
TextS.isPrefixOf Identifier
"c$" Identifier
nmExt of
Bool
True -> [Identifier] -> Identifier
TextS.concat [Identifier
"\\",Identifier
nmExt,Identifier
"\\"]
Bool
_ -> [Identifier] -> Identifier
TextS.concat [Identifier
"\\c$",Identifier
nmExt,Identifier
"\\"]
| Bool
otherwise -> Identifier
nm'
setModName :: Identifier -> VHDLState -> VHDLState
setModName Identifier
nm VHDLState
s = VHDLState
s {_modNm :: Identifier
_modNm = Identifier
nm}
setSrcSpan :: SrcSpan -> State VHDLState ()
setSrcSpan = ((SrcSpan -> Identity SrcSpan) -> VHDLState -> Identity VHDLState
Lens' VHDLState SrcSpan
srcSpan ((SrcSpan -> Identity SrcSpan) -> VHDLState -> Identity VHDLState)
-> SrcSpan -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
getSrcSpan :: State VHDLState SrcSpan
getSrcSpan = Getting SrcSpan VHDLState SrcSpan -> State VHDLState SrcSpan
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting SrcSpan VHDLState SrcSpan
Lens' VHDLState SrcSpan
srcSpan
blockDecl :: Identifier -> [Declaration] -> Mon (State VHDLState) Doc
blockDecl Identifier
nm [Declaration]
ds = do
Doc
decs <- [Declaration] -> Mon (State VHDLState) Doc
decls [Declaration]
ds
let attrs :: [(Identifier, Attr')]
attrs = [ (Identifier
id_, Attr'
attr)
| NetDecl' Maybe Identifier
_ WireOrReg
_ Identifier
id_ (Right HWType
hwtype) Maybe Expr
_ <- [Declaration]
ds
, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
if Doc -> Bool
isEmpty Doc
decs
then [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
else Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
(Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"block" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
if [(Identifier, Attr')] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr')]
attrs
then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
else Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs [(Identifier, Attr')]
attrs) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
(Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
[Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end block" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
unextend :: State VHDLState (Identifier -> Identifier)
unextend = (Identifier -> Identifier)
-> State VHDLState (Identifier -> Identifier)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier -> Identifier
rmSlash
addIncludes :: [(String, Doc)] -> State VHDLState ()
addIncludes [(String, Doc)]
inc = ([(String, Doc)] -> Identity [(String, Doc)])
-> VHDLState -> Identity VHDLState
Lens' VHDLState [(String, Doc)]
includes (([(String, Doc)] -> Identity [(String, Doc)])
-> VHDLState -> Identity VHDLState)
-> ([(String, Doc)] -> [(String, Doc)]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([(String, Doc)]
inc[(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. [a] -> [a] -> [a]
++)
addLibraries :: [Text] -> State VHDLState ()
addLibraries [Text]
libs = ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Text]
libs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
addImports :: [Text] -> State VHDLState ()
addImports [Text]
imps = ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
packages (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Text]
imps [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++)
addAndSetData :: String -> State VHDLState String
addAndSetData String
f = do
[(String, String)]
fs <- Getting [(String, String)] VHDLState [(String, String)]
-> State VHDLState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VHDLState [(String, String)]
Lens' VHDLState [(String, String)]
dataFiles
let ([(String, String)]
fs',String
f') = [(String, String)] -> String -> ([(String, String)], String)
renderFilePath [(String, String)]
fs String
f
([(String, String)] -> Identity [(String, String)])
-> VHDLState -> Identity VHDLState
Lens' VHDLState [(String, String)]
dataFiles (([(String, String)] -> Identity [(String, String)])
-> VHDLState -> Identity VHDLState)
-> [(String, String)] -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(String, String)]
fs'
String -> State VHDLState String
forall (m :: Type -> Type) a. Monad m => a -> m a
return String
f'
getDataFiles :: State VHDLState [(String, String)]
getDataFiles = Getting [(String, String)] VHDLState [(String, String)]
-> State VHDLState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VHDLState [(String, String)]
Lens' VHDLState [(String, String)]
dataFiles
addMemoryDataFile :: (String, String) -> State VHDLState ()
addMemoryDataFile (String, String)
f = ([(String, String)] -> Identity [(String, String)])
-> VHDLState -> Identity VHDLState
Lens' VHDLState [(String, String)]
memoryDataFiles (([(String, String)] -> Identity [(String, String)])
-> VHDLState -> Identity VHDLState)
-> ([(String, String)] -> [(String, String)]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String, String)
f(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)
getMemoryDataFiles :: State VHDLState [(String, String)]
getMemoryDataFiles = Getting [(String, String)] VHDLState [(String, String)]
-> State VHDLState [(String, String)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, String)] VHDLState [(String, String)]
Lens' VHDLState [(String, String)]
memoryDataFiles
seenIdentifiers :: (HashMap Identifier Word -> f (HashMap Identifier Word))
-> VHDLState -> f VHDLState
seenIdentifiers = (HashMap Identifier Word -> f (HashMap Identifier Word))
-> VHDLState -> f VHDLState
Lens' VHDLState (HashMap Identifier Word)
idSeen
ifThenElseExpr :: VHDLState -> Bool
ifThenElseExpr VHDLState
_ = Bool
False
rmSlash :: Identifier -> Identifier
rmSlash :: Identifier -> Identifier
rmSlash Identifier
nm = Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
nm (Maybe Identifier -> Identifier) -> Maybe Identifier -> Identifier
forall a b. (a -> b) -> a -> b
$ do
Identifier
nm1 <- Identifier -> Identifier -> Maybe Identifier
TextS.stripPrefix Identifier
"\\" Identifier
nm
Identifier -> Maybe Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Char -> Bool) -> Identifier -> Identifier
TextS.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')) Identifier
nm1)
type VHDLM a = Mon (State VHDLState) a
isBV :: HWType -> Bool
isBV :: HWType -> Bool
isBV (HWType -> HWType
normaliseType -> BitVector Int
_) = Bool
True
isBV HWType
_ = Bool
False
timeUnits :: [Identifier]
timeUnits :: [Identifier]
timeUnits = [Identifier
"fs", Identifier
"ps", Identifier
"ns", Identifier
"us", Identifier
"ms", Identifier
"sec", Identifier
"min", Identifier
"hr"]
importedNames :: [Identifier]
importedNames :: [Identifier]
importedNames =
[
Identifier
"std_ulogic", Identifier
"std_ulogic_vector", Identifier
"resolved", Identifier
"std_logic", Identifier
"std_logic_vector"
, Identifier
"x01", Identifier
"x01z", Identifier
"ux01", Identifier
"ux01z", Identifier
"to_bit", Identifier
"to_bitvector", Identifier
"to_stdulogic"
, Identifier
"to_stdlogicvector", Identifier
"to_stdulogicvector", Identifier
"to_01", Identifier
"to_x01", Identifier
"to_x01z"
, Identifier
"to_ux01", Identifier
"rising_edge", Identifier
"falling_edge", Identifier
"is_x"
, Identifier
"unresolved_unsigned", Identifier
"unresolved_signed", Identifier
"u_unsigned", Identifier
"u_signed"
, Identifier
"unsigned", Identifier
"signed", Identifier
"find_leftmost", Identifier
"find_rightmost", Identifier
"minimum"
, Identifier
"maximum", Identifier
"shift_left", Identifier
"shift_right", Identifier
"rotate_left", Identifier
"rotate_right"
, Identifier
"resize", Identifier
"to_integer", Identifier
"to_unsigned", Identifier
"to_signed", Identifier
"std_match"
, Identifier
"math_e", Identifier
"math_1_over_e", Identifier
"math_pi", Identifier
"math_2_pi", Identifier
"math_1_over_pi"
, Identifier
"math_pi_over_2", Identifier
"math_pi_over_3", Identifier
"path_pi_over_4", Identifier
"path_3_pi_over_2"
, Identifier
"math_log_of_2", Identifier
"math_log_of_10", Identifier
"math_log10_of_e", Identifier
"math_sqrt_2"
, Identifier
"math_1_over_sqrt_2", Identifier
"math_sqrt_pi", Identifier
"math_deg_to_rad", Identifier
"math_rad_to_deg"
, Identifier
"sign", Identifier
"ceil", Identifier
"floor", Identifier
"round", Identifier
"trunc", Identifier
"realmax", Identifier
"realmin", Identifier
"uniform"
, Identifier
"sqrt", Identifier
"cbrt", Identifier
"exp", Identifier
"log", Identifier
"log2", Identifier
"log10", Identifier
"sin", Identifier
"cos", Identifier
"tan", Identifier
"arcsin"
, Identifier
"arccos", Identifier
"arctan", Identifier
"sinh", Identifier
"cosh", Identifier
"tanh", Identifier
"arcsinh", Identifier
"arccosh", Identifier
"arctanh"
, Identifier
"line", Identifier
"text", Identifier
"side", Identifier
"width", Identifier
"justify", Identifier
"input", Identifier
"output", Identifier
"readline"
, Identifier
"read", Identifier
"sread", Identifier
"string_read", Identifier
"bread", Identifier
"binary_read", Identifier
"oread", Identifier
"octal_read"
, Identifier
"hread", Identifier
"hex_read", Identifier
"writeline", Identifier
"tee", Identifier
"write", Identifier
"swrite", Identifier
"string_write"
, Identifier
"bwrite", Identifier
"binary_write", Identifier
"owrite", Identifier
"octal_write", Identifier
"hwrite", Identifier
"hex_write"
]
reservedWords :: [Identifier]
reservedWords :: [Identifier]
reservedWords = [Identifier
"abs",Identifier
"access",Identifier
"after",Identifier
"alias",Identifier
"all",Identifier
"and",Identifier
"architecture"
,Identifier
"array",Identifier
"assert",Identifier
"assume",Identifier
"assume_guarantee",Identifier
"attribute",Identifier
"begin",Identifier
"block"
,Identifier
"body",Identifier
"buffer",Identifier
"bus",Identifier
"case",Identifier
"component",Identifier
"configuration",Identifier
"constant",Identifier
"context"
,Identifier
"cover",Identifier
"default",Identifier
"disconnect",Identifier
"downto",Identifier
"else",Identifier
"elsif",Identifier
"end",Identifier
"entity",Identifier
"exit"
,Identifier
"fairness",Identifier
"file",Identifier
"for",Identifier
"force",Identifier
"function",Identifier
"generate",Identifier
"generic",Identifier
"group"
,Identifier
"guarded",Identifier
"if",Identifier
"impure",Identifier
"in",Identifier
"inertial",Identifier
"inout",Identifier
"is",Identifier
"label",Identifier
"library"
,Identifier
"linkage",Identifier
"literal",Identifier
"loop",Identifier
"map",Identifier
"mod",Identifier
"nand",Identifier
"new",Identifier
"next",Identifier
"nor",Identifier
"not",Identifier
"null"
,Identifier
"of",Identifier
"on",Identifier
"open",Identifier
"or",Identifier
"others",Identifier
"out",Identifier
"package",Identifier
"parameter",Identifier
"port",Identifier
"postponed"
,Identifier
"procedure",Identifier
"process",Identifier
"property",Identifier
"protected",Identifier
"pure",Identifier
"range",Identifier
"record"
,Identifier
"register",Identifier
"reject",Identifier
"release",Identifier
"rem",Identifier
"report",Identifier
"restrict",Identifier
"restrict_guarantee"
,Identifier
"return",Identifier
"rol",Identifier
"ror",Identifier
"select",Identifier
"sequence",Identifier
"severity",Identifier
"signal",Identifier
"shared",Identifier
"sla"
,Identifier
"sll",Identifier
"sra",Identifier
"srl",Identifier
"strong",Identifier
"subtype",Identifier
"then",Identifier
"to",Identifier
"transport",Identifier
"type"
,Identifier
"unaffected",Identifier
"units",Identifier
"until",Identifier
"use",Identifier
"variable",Identifier
"vmode",Identifier
"vprop",Identifier
"vunit",Identifier
"wait"
,Identifier
"when",Identifier
"while",Identifier
"with",Identifier
"xnor",Identifier
"xor",Identifier
"toslv",Identifier
"fromslv",Identifier
"tagtoenum",Identifier
"datatotag"
,Identifier
"integer", Identifier
"boolean", Identifier
"std_logic", Identifier
"std_logic_vector", Identifier
"signed", Identifier
"unsigned"
,Identifier
"to_integer", Identifier
"to_signed", Identifier
"to_unsigned", Identifier
"string",Identifier
"log"] [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier]
timeUnits [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier]
importedNames
filterReserved :: Identifier -> Identifier
filterReserved :: Identifier -> Identifier
filterReserved Identifier
s = if Identifier
s Identifier -> [Identifier] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Identifier]
reservedWords
then Identifier
s Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_r"
else Identifier
s
stripTrailingUnderscore :: Identifier -> Identifier
stripTrailingUnderscore :: Identifier -> Identifier
stripTrailingUnderscore = (Char -> Bool) -> Identifier -> Identifier
TextS.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
productFieldNames
:: HasCallStack
=> Maybe [TextS.Text]
-> [HWType]
-> VHDLM [TextS.Text]
productFieldNames :: Maybe [Identifier] -> [HWType] -> VHDLM [Identifier]
productFieldNames Maybe [Identifier]
labels0 [HWType]
fields = do
let labels1 :: [Maybe Identifier]
labels1 = Maybe [Identifier] -> [Maybe Identifier]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe [Identifier]
labels0 [Maybe Identifier] -> [Maybe Identifier] -> [Maybe Identifier]
forall a. [a] -> [a] -> [a]
++ Maybe Identifier -> [Maybe Identifier]
forall a. a -> [a]
repeat Maybe Identifier
forall a. Maybe a
Nothing
[Identifier]
hFields <- (Maybe Identifier -> HWType -> Mon (State VHDLState) Identifier)
-> [Maybe Identifier] -> [HWType] -> VHDLM [Identifier]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe Identifier -> HWType -> Mon (State VHDLState) Identifier
hName [Maybe Identifier]
labels1 [HWType]
fields
let grouped :: [[Identifier]]
grouped = [Identifier] -> [[Identifier]]
forall a. Eq a => [a] -> [[a]]
group ([Identifier] -> [[Identifier]]) -> [Identifier] -> [[Identifier]]
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Identifier]
forall a. Ord a => [a] -> [a]
sort ([Identifier] -> [Identifier]) -> [Identifier] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ [Identifier]
hFields
counted :: HashMap Identifier Int
counted = [(Identifier, Int)] -> HashMap Identifier Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMapS.fromList (([Identifier] -> (Identifier, Int))
-> [[Identifier]] -> [(Identifier, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Identifier
g:[Identifier]
gs) -> (Identifier
g, Int -> Int
forall a. Enum a => a -> a
succ ([Identifier] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Identifier]
gs))) [[Identifier]]
grouped)
names :: [Identifier]
names = (HashMap Identifier Int, [Identifier]) -> [Identifier]
forall a b. (a, b) -> b
snd ((HashMap Identifier Int, [Identifier]) -> [Identifier])
-> (HashMap Identifier Int, [Identifier]) -> [Identifier]
forall a b. (a -> b) -> a -> b
$ (HashMap Identifier Int
-> Identifier -> (HashMap Identifier Int, Identifier))
-> HashMap Identifier Int
-> [Identifier]
-> (HashMap Identifier Int, [Identifier])
forall (t :: Type -> Type) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (HashMap Identifier Int
-> HashMap Identifier Int
-> Identifier
-> (HashMap Identifier Int, Identifier)
name' HashMap Identifier Int
counted) HashMap Identifier Int
forall k v. HashMap k v
HashMapS.empty [Identifier]
hFields
[Identifier] -> VHDLM [Identifier]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Identifier]
names
where
hName
:: Maybe Identifier
-> HWType
-> VHDLM Identifier
hName :: Maybe Identifier -> HWType -> Mon (State VHDLState) Identifier
hName Maybe Identifier
Nothing HWType
field =
HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
False HWType
field
hName (Just Identifier
label) HWType
_field = do
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic State VHDLState (Identifier -> Identifier)
-> State VHDLState Identifier -> State VHDLState Identifier
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Identifier -> State VHDLState Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Identifier
label)
name'
:: HashMap TextS.Text Int
-> HashMap TextS.Text Int
-> TextS.Text
-> (HashMap TextS.Text Int, TextS.Text)
name' :: HashMap Identifier Int
-> HashMap Identifier Int
-> Identifier
-> (HashMap Identifier Int, Identifier)
name' HashMap Identifier Int
counted HashMap Identifier Int
countMap Identifier
fieldName
| HashMap Identifier Int
counted HashMap Identifier Int -> Identifier -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMapS.! Identifier
fieldName Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
let succ' :: Maybe Int -> Maybe Int
succ' Maybe Int
n = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
0 :: Int) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Maybe Int
n) in
let countMap' :: HashMap Identifier Int
countMap' = (Maybe Int -> Maybe Int)
-> Identifier -> HashMap Identifier Int -> HashMap Identifier Int
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMapS.alter Maybe Int -> Maybe Int
succ' Identifier
fieldName HashMap Identifier Int
countMap in
let count :: Int
count = HashMap Identifier Int
countMap' HashMap Identifier Int -> Identifier -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMapS.! Identifier
fieldName in
(HashMap Identifier Int
countMap', [Identifier] -> Identifier
TextS.concat [Identifier
fieldName, Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
count])
| Bool
otherwise =
(HashMap Identifier Int
countMap, Identifier
fieldName)
productFieldName
:: HasCallStack
=> Maybe [TextS.Text]
-> [HWType]
-> Int
-> VHDLM Doc
productFieldName :: Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
productFieldName Maybe [Identifier]
labels [HWType]
fields Int
fieldIndex = do
[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]
-> [HWType]
-> Int
-> VHDLM Doc
selectProductField :: Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
fieldLabels [HWType]
fieldTypes Int
fieldIndex =
Mon (State VHDLState) Doc
"_sel" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fieldIndex Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
productFieldName Maybe [Identifier]
fieldLabels [HWType]
fieldTypes Int
fieldIndex
genVHDL :: Identifier -> SrcSpan -> HashMapS.HashMap Identifier Word -> Component -> VHDLM ((String,Doc),[(String,Doc)])
genVHDL :: Identifier
-> SrcSpan
-> HashMap Identifier Word
-> Component
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
genVHDL Identifier
nm SrcSpan
sp HashMap Identifier Word
seen Component
c = Mon (State VHDLState) ((String, Doc), [(String, Doc)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
forall s a. Backend s => Mon (State s) a -> Mon (State s) a
preserveSeen (Mon (State VHDLState) ((String, Doc), [(String, Doc)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)]))
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
forall a b. (a -> b) -> a -> b
$ do
State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashMap Identifier Word)
idSeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState)
-> HashMap Identifier Word -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= HashMap Identifier Word
seen
State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashMap Identifier Word)
tySeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Word -> Word -> Word)
-> HashMap Identifier Word
-> HashMap Identifier Word
-> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith Word -> Word -> Word
forall a. Ord a => a -> a -> a
max HashMap Identifier Word
seen
State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> State VHDLState ()
forall state. Backend state => SrcSpan -> State state ()
setSrcSpan SrcSpan
sp
Doc
v <- Mon (State VHDLState) Doc
vhdl
[(String, Doc)]
i <- State VHDLState [(String, Doc)]
-> Mon (State VHDLState) [(String, Doc)]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState [(String, Doc)]
-> Mon (State VHDLState) [(String, Doc)])
-> State VHDLState [(String, Doc)]
-> Mon (State VHDLState) [(String, Doc)]
forall a b. (a -> b) -> a -> b
$ Getting [(String, Doc)] VHDLState [(String, Doc)]
-> State VHDLState [(String, Doc)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [(String, Doc)] VHDLState [(String, Doc)]
Lens' VHDLState [(String, Doc)]
includes
State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> [Text] -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= []
State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState () -> Mon (State VHDLState) ())
-> State VHDLState () -> Mon (State VHDLState) ()
forall a b. (a -> b) -> a -> b
$ ([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
packages (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> [Text] -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= []
((String, Doc), [(String, Doc)])
-> Mon (State VHDLState) ((String, Doc), [(String, Doc)])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((Identifier -> String
TextS.unpack Identifier
cName,Doc
v),[(String, Doc)]
i)
where
cName :: Identifier
cName = Component -> Identifier
componentName Component
c
vhdl :: Mon (State VHDLState) Doc
vhdl = do
Doc
ent <- Component -> Mon (State VHDLState) Doc
entity Component
c
Doc
arch <- Component -> Mon (State VHDLState) Doc
architecture Component
c
Doc
imps <- Identifier -> Mon (State VHDLState) Doc
tyImports Identifier
nm
(Mon (State VHDLState) Doc
"-- Automatically generated VHDL-93" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
imps Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
ent Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
arch)
mkTyPackage_ :: Identifier
-> [HWType]
-> VHDLM [(String,Doc)]
mkTyPackage_ :: Identifier -> [HWType] -> Mon (State VHDLState) [(String, Doc)]
mkTyPackage_ Identifier
modName ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent -> [HWType]
hwtys) = do
{ HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
; Identifier -> Identifier
mkId <- State VHDLState (Identifier -> Identifier)
-> Mon (State VHDLState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic)
; let usedTys :: [HWType]
usedTys = (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
hwtys
; let normTys0 :: [HWType]
normTys0 = [HWType] -> [HWType]
forall a. Eq a => [a] -> [a]
nub ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
mkVecZ ([HWType]
hwtys [HWType] -> [HWType] -> [HWType]
forall a. [a] -> [a] -> [a]
++ [HWType]
usedTys))
; let sortedTys0 :: [HWType]
sortedTys0 = [HWType] -> [HWType]
topSortHWTys [HWType]
normTys0
packageDec :: Mon (State VHDLState) Doc
packageDec = Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (HWType -> Mon (State VHDLState) Doc)
-> [HWType] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec ((HWType -> HWType -> Bool) -> [HWType] -> [HWType]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy HWType -> HWType -> Bool
eqTypM [HWType]
sortedTys0)
([Mon (State VHDLState) Doc]
funDecs,[Mon (State VHDLState) Doc]
funBodies) = [(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc]))
-> ([HWType]
-> [(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)])
-> [HWType]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWType
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc))
-> [HWType]
-> [(Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HdlSyn
-> HWType
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
funDec HdlSyn
syn) ([HWType]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc]))
-> [HWType]
-> ([Mon (State VHDLState) Doc], [Mon (State VHDLState) Doc])
forall a b. (a -> b) -> a -> b
$ (HWType -> HWType -> Bool) -> [HWType] -> [HWType]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy HWType -> HWType -> Bool
eqTypM ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
normaliseType [HWType]
sortedTys0)
; ((String, Doc) -> [(String, Doc)] -> [(String, Doc)]
forall a. a -> [a] -> [a]
:[]) ((String, Doc) -> [(String, Doc)])
-> (Doc -> (String, Doc)) -> Doc -> [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Identifier -> String
TextS.unpack (Identifier -> String) -> Identifier -> String
forall a b. (a -> b) -> a -> b
$ Identifier -> Identifier
mkId (Identifier
modName Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_types"),) (Doc -> [(String, Doc)])
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [(String, Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
Mon (State VHDLState) Doc
"library IEEE;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"use IEEE.STD_LOGIC_1164.ALL;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"use IEEE.NUMERIC_STD.ALL;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"package" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
mkId (Identifier
modName Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_types")) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ( Mon (State VHDLState) Doc
packageDec Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc]
funDecs)
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Mon (State VHDLState) Doc] -> Mon (State VHDLState) Doc
packageBodyDec [Mon (State VHDLState) Doc]
funBodies
}
where
packageBodyDec :: [VHDLM Doc] -> VHDLM Doc
packageBodyDec :: [Mon (State VHDLState) Doc] -> Mon (State VHDLState) Doc
packageBodyDec [Mon (State VHDLState) Doc]
funBodies = case [Mon (State VHDLState) Doc]
funBodies of
[] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
[Mon (State VHDLState) Doc]
_ -> do
{ Identifier -> Identifier
mkId <- State VHDLState (Identifier -> Identifier)
-> Mon (State VHDLState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic)
; Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"package" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"body" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
mkId (Identifier
modName Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_types")) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc]
funBodies)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
}
eqTypM :: HWType -> HWType -> Bool
eqTypM :: HWType -> HWType -> Bool
eqTypM (Signed Int
_) (Signed Int
_) = Bool
True
eqTypM (Unsigned Int
_) (Unsigned Int
_) = Bool
True
eqTypM (BitVector Int
_) (BitVector Int
_) = Bool
True
eqTypM HWType
ty1 HWType
ty2 = HWType
ty1 HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
ty2
mkUsedTys :: HWType -> [HWType]
mkUsedTys :: HWType -> [HWType]
mkUsedTys HWType
hwty = HWType
hwty HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: case HWType
hwty of
Vector Int
_ HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
RTree Int
_ HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
Product Identifier
_ Maybe [Identifier]
_ [HWType]
elTys -> (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
elTys
SP Identifier
_ [(Identifier, [HWType])]
elTys -> (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Identifier, [HWType])]
elTys)
BiDirectional PortDirection
_ HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
Annotated [Attr']
_ HWType
elTy -> HWType -> [HWType]
mkUsedTys HWType
elTy
CustomProduct Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ [(FieldAnn, HWType)]
tys0 ->
(HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((FieldAnn, HWType) -> HWType) -> [(FieldAnn, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd [(FieldAnn, HWType)]
tys0)
CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
tys0 ->
let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (ConstrRepr'
_repr, Identifier
_id, [HWType]
tys) <- [(ConstrRepr', Identifier, [HWType])]
tys0] in
(HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
tys1
HWType
_ ->
[]
topSortHWTys
:: [HWType]
-> [HWType]
topSortHWTys :: [HWType] -> [HWType]
topSortHWTys [HWType]
hwtys = [HWType]
sorted
where
nodes :: [(Int, HWType)]
nodes = [Int] -> [HWType] -> [(Int, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [HWType]
hwtys
nodesI :: HashMap HWType Int
nodesI = [(HWType, Int)] -> HashMap HWType Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([HWType] -> [Int] -> [(HWType, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
hwtys [Int
0..])
edges :: [(Int, Int)]
edges = (HWType -> [(Int, Int)]) -> [HWType] -> [(Int, Int)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [(Int, Int)]
edge [HWType]
hwtys
sorted :: [HWType]
sorted =
case [(Int, HWType)] -> [(Int, Int)] -> Either String [HWType]
forall a. [(Int, a)] -> [(Int, Int)] -> Either String [a]
reverseTopSort [(Int, HWType)]
nodes [(Int, Int)]
edges of
Left String
err -> String -> [HWType]
forall a. HasCallStack => String -> a
error (String -> [HWType]) -> String -> [HWType]
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[BUG IN CLASH] topSortHWTys: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
Right [HWType]
ns -> [HWType]
ns
edge :: HWType -> [(Int, Int)]
edge t :: HWType
t@(Vector Int
_ HWType
elTy) =
case HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
elTy) HashMap HWType Int
nodesI of
Just Int
node ->
[(HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t, Int
node)]
Maybe Int
Nothing ->
[]
edge t :: HWType
t@(RTree Int
_ HWType
elTy) =
let vecZ :: HWType
vecZ = HWType -> HWType
mkVecZ HWType
elTy in
case HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
vecZ HashMap HWType Int
nodesI of
Just Int
node ->
[(HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t, Int
node)] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ HWType -> [(Int, Int)]
edge HWType
elTy
Maybe Int
Nothing ->
[]
edge t :: HWType
t@(Product Identifier
_ Maybe [Identifier]
_ [HWType]
tys0) =
let tys1 :: [Maybe Int]
tys1 = [HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Int
nodesI | HWType
ty <- [HWType]
tys0] in
(Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
tys1)
edge t :: HWType
t@(SP Identifier
_ [(Identifier, [HWType])]
tys0) =
let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat (((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [[HWType]]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Identifier, [HWType])]
tys0) in
let tys2 :: [Maybe Int]
tys2 = [HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Int
nodesI | HWType
ty <- [HWType]
tys1] in
(Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
tys2)
edge t :: HWType
t@(CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
tys0) =
let tys1 :: [HWType]
tys1 = [[HWType]] -> [HWType]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[HWType]
tys | (ConstrRepr'
_repr, Identifier
_id, [HWType]
tys) <- [(ConstrRepr', Identifier, [HWType])]
tys0] in
let tys2 :: [Maybe Int]
tys2 = [HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Int
nodesI | HWType
ty <- [HWType]
tys1] in
(Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
tys2)
edge t :: HWType
t@(CustomProduct Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ (((FieldAnn, HWType) -> HWType) -> [(FieldAnn, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd -> [HWType]
tys0)) =
let tys1 :: [Maybe Int]
tys1 = [HWType -> HashMap HWType Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (HWType -> HWType
mkVecZ HWType
ty) HashMap HWType Int
nodesI | HWType
ty <- [HWType]
tys0] in
(Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap HWType Int
nodesI HashMap HWType Int -> HWType -> Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! HWType
t,) ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
tys1)
edge HWType
_ = []
mkVecZ :: HWType -> HWType
mkVecZ :: HWType -> HWType
mkVecZ (Vector Int
_ HWType
elTy) = Int -> HWType -> HWType
Vector Int
0 HWType
elTy
mkVecZ (RTree Int
_ HWType
elTy) = Int -> HWType -> HWType
RTree Int
0 HWType
elTy
mkVecZ HWType
t = HWType
t
typAliasDec :: HasCallStack => HWType -> VHDLM Doc
typAliasDec :: HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty =
Mon (State VHDLState) Doc
"subtype" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedTyName (HWType -> HWType
normaliseType HWType
hwty)
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
tyDec :: HasCallStack => HWType -> VHDLM Doc
tyDec :: HWType -> Mon (State VHDLState) Doc
tyDec HWType
hwty = do
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
case HWType
hwty of
Vector Int
_ HWType
elTy ->
case HdlSyn
syn of
HdlSyn
Vivado ->
Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is array (integer range <>) of std_logic_vector"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
HdlSyn
_ ->
Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is array (integer range <>) of"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
elTy
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
RTree Int
_ HWType
elTy ->
case HdlSyn
syn of
HdlSyn
Vivado ->
Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is array (integer range <>) of"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
HdlSyn
_ ->
Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is array (integer range <>) of"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
elTy
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
Product Identifier
_ Maybe [Identifier]
labels tys :: [HWType]
tys@(HWType
_:HWType
_:[HWType]
_) ->
let selNames :: [Mon (State VHDLState) Doc]
selNames = (Int -> Mon (State VHDLState) Doc)
-> [Int] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
i) [Int
0..] in
let selTys :: [Mon (State VHDLState) Doc]
selTys = (HWType -> Mon (State VHDLState) Doc)
-> [HWType] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Mon (State VHDLState) Doc
sizedQualTyName [HWType]
tys in
Mon (State VHDLState) Doc
"type" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is record" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc]
-> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Mon (State VHDLState) Doc
x Mon (State VHDLState) Doc
y -> Mon (State VHDLState) Doc
x Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
y Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) [Mon (State VHDLState) Doc]
selNames [Mon (State VHDLState) Doc]
selTys) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end record" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
Clock Identifier
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
Reset Identifier
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
Index FieldAnn
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
SP Identifier
_ [(Identifier, [HWType])]
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
Sum Identifier
_ [Identifier]
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
CustomProduct {} -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
typAliasDec HWType
hwty
BitVector Int
_ -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
Bool -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
Bit -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Unsigned Int
_ -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
Signed Int
_ -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
String -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
Integer -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
BiDirectional PortDirection
_ HWType
ty -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec HWType
ty
Annotated [Attr']
_ HWType
ty -> HasCallStack => HWType -> Mon (State VHDLState) Doc
HWType -> Mon (State VHDLState) Doc
tyDec HWType
ty
Void {} -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
KnownDomain {} -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
HWType
_ -> String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
hwty
funDec :: HdlSyn -> HWType -> Maybe (VHDLM Doc,VHDLM Doc)
funDec :: HdlSyn
-> HWType
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
funDec HdlSyn
_ HWType
Bool = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"b" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"sl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"tagToEnum" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"s" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"dataToTag" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"b" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"b" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"b" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"then"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"else"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
]) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"sl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"sl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"then"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"true" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"else"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"false" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
]) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"tagToEnum" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"s" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"s" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> (State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth) Mon (State VHDLState) Int
-> (Int -> Mon (State VHDLState) Doc) -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"then"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"false" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"else"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"true" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
]) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"dataToTag" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"b" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"boolean") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"b" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"then"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> (State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth) Mon (State VHDLState) Int
-> (Int -> Mon (State VHDLState) Doc) -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"else"
, Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> (State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth) Mon (State VHDLState) Int
-> (Int -> Mon (State VHDLState) Doc) -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
,Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"if" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
]) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
funDec HdlSyn
_ bit :: HWType
bit@HWType
Bit = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"sl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
bit) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
bit Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"sl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
bit) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"sl") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
bit Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"alias islv : std_logic_vector (0 to slv'length - 1) is slv;"
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"islv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
funDec HdlSyn
_ (Signed Int
_) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"s" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"s" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"s") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"islv") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
funDec HdlSyn
_ (Unsigned Int
_) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"u" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"unsigned") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"u" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"unsigned") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"u") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 Mon (State VHDLState) Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"islv") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
funDec HdlSyn
_ t :: HWType
t@(Product Identifier
_ Maybe [Identifier]
labels [HWType]
elTys) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"p :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"p :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " Mon (State VHDLState) [Doc]
elTyToSLV)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"alias islv : std_logic_vector(0 to slv'length - 1) is slv;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
"," Mon (State VHDLState) [Doc]
elTyFromSLV)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
where
elTyToSLV :: Mon (State VHDLState) [Doc]
elTyToSLV = [Int]
-> (Int -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..([HWType] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
elTys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
(\Int
i -> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"p." Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) Doc
tyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
elTys Int
i))
argLengths :: [Int]
argLengths = (HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
elTys
starts :: [Int]
starts = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int, [Int]) -> [Int]
forall a b. (a, b) -> b
snd ((Int -> Int -> (Int, Int)) -> Int -> [Int] -> (Int, [Int])
forall (t :: Type -> Type) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (((Int -> Int -> (Int, Int)) -> Int -> (Int, Int)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (,) (Int -> (Int, Int)) -> (Int -> Int) -> Int -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> Int) -> Int -> (Int, Int))
-> (Int -> Int -> Int) -> Int -> Int -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)) Int
0 [Int]
argLengths)
ends :: [Int]
ends = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
starts)
elTyFromSLV :: Mon (State VHDLState) [Doc]
elTyFromSLV = [(Int, Int)]
-> ((Int, Int) -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
starts [Int]
ends)
(\(Int
s,Int
e) -> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"islv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)))
funDec HdlSyn
syn t :: HWType
t@(Vector Int
_ HWType
elTy) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"value : " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"value : " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"alias ivalue :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"(1 to value'length) is value;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"variable result :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"1 to value'length * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
(Mon (State VHDLState) Doc
"for i in ivalue'range loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"(i - 1) * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"+ 1" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
"to i*" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
":=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (case HdlSyn
syn of
HdlSyn
Vivado -> Mon (State VHDLState) Doc
"ivalue" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"i")
HdlSyn
_ -> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"ivalue" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"i"))) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"alias islv :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"(0 to slv'length - 1) is slv;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"variable result :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"0 to slv'length / " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
eSz Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"- 1") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
(Mon (State VHDLState) Doc
"for i in result'range loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
"i" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
":=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> case HdlSyn
syn of
HdlSyn
Vivado -> Mon (State VHDLState) Doc
getElem Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
HdlSyn
_ | BitVector Int
_ <- HWType
elTy -> Mon (State VHDLState) Doc
getElem Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
| Bool
otherwise -> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
getElem Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
where
eSz :: Mon (State VHDLState) Doc
eSz = Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)
getElem :: Mon (State VHDLState) Doc
getElem = Mon (State VHDLState) Doc
"islv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"i * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
eSz Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to (i+1) * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
eSz Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"- 1")
funDec HdlSyn
_ (BitVector Int
_) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
funDec HdlSyn
syn t :: HWType
t@(RTree Int
_ HWType
elTy) = (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
-> Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. a -> Maybe a
Just
( Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"value : " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
, Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"value : " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"alias ivalue :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"(1 to value'length) is value;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"variable result :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"1 to value'length * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
(Mon (State VHDLState) Doc
"for i in ivalue'range loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"(i - 1) * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"+ 1" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
"to i*" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
":=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (case HdlSyn
syn of
HdlSyn
Vivado -> Mon (State VHDLState) Doc
"ivalue" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"i")
HdlSyn
_ -> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"ivalue" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"i"))) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"function" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"slv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"in" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"alias islv :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"(0 to slv'length - 1) is slv;" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"variable result :" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"0 to slv'length / " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
eSz Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"- 1") Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
(Mon (State VHDLState) Doc
"for i in result'range loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
( Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
"i" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
":=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> case HdlSyn
syn of
HdlSyn
Vivado -> Mon (State VHDLState) Doc
getElem Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
HdlSyn
_ | BitVector Int
_ <- HWType
elTy -> Mon (State VHDLState) Doc
getElem Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
| Bool
otherwise -> Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
getElem Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"loop" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"return" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"result" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
where
eSz :: Mon (State VHDLState) Doc
eSz = Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy)
getElem :: Mon (State VHDLState) Doc
getElem = Mon (State VHDLState) Doc
"islv" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"i * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
eSz Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to (i+1) * " Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
eSz Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"- 1")
funDec HdlSyn
_ HWType
_ = Maybe (Mon (State VHDLState) Doc, Mon (State VHDLState) Doc)
forall a. Maybe a
Nothing
tyImports :: Identifier -> VHDLM Doc
tyImports :: Identifier -> Mon (State VHDLState) Doc
tyImports Identifier
nm = do
Identifier -> Identifier
mkId <- State VHDLState (Identifier -> Identifier)
-> Mon (State VHDLState) (Identifier -> Identifier)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic)
[Text]
libs <- State VHDLState [Text] -> Mon (State VHDLState) [Text]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState [Text] -> Mon (State VHDLState) [Text])
-> State VHDLState [Text] -> Mon (State VHDLState) [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] VHDLState [Text] -> State VHDLState [Text]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Text] VHDLState [Text]
Lens' VHDLState [Text]
libraries
[Text]
packs <- State VHDLState [Text] -> Mon (State VHDLState) [Text]
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState [Text] -> Mon (State VHDLState) [Text])
-> State VHDLState [Text] -> Mon (State VHDLState) [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] VHDLState [Text] -> State VHDLState [Text]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Text] VHDLState [Text]
Lens' VHDLState [Text]
packages
Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (m :: Type -> Type).
Monad m =>
Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
([ Mon (State VHDLState) Doc
"library IEEE"
, Mon (State VHDLState) Doc
"use IEEE.STD_LOGIC_1164.ALL"
, Mon (State VHDLState) Doc
"use IEEE.NUMERIC_STD.ALL"
, Mon (State VHDLState) Doc
"use IEEE.MATH_REAL.ALL"
, Mon (State VHDLState) Doc
"use std.textio.all"
, Mon (State VHDLState) Doc
"use work.all"
, Mon (State VHDLState) Doc
"use work." Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
mkId (Identifier
nm Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_types")) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
".all"
] [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. [a] -> [a] -> [a]
++ ((Text -> Mon (State VHDLState) Doc)
-> [Text] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Mon (State VHDLState) Doc
"library" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>) (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Text -> Mon (State VHDLState) Doc)
-> Text
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
libs))
[Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. [a] -> [a] -> [a]
++ ((Text -> Mon (State VHDLState) Doc)
-> [Text] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Mon (State VHDLState) Doc
"use" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>) (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Text -> Mon (State VHDLState) Doc)
-> Text
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
packs)))
port :: Num t
=> TextS.Text
-> HWType
-> VHDLM Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port :: Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port Identifier
elName HWType
hwType Mon (State VHDLState) Doc
portDirection Int
fillToN Maybe Expr
iEM =
(,Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$ Identifier -> Int
TextS.length Identifier
elName) (Doc -> (Doc, t)) -> Mon (State VHDLState) Doc -> VHDLM (Doc, t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
(HWType -> Mon (State VHDLState) Doc
encodingNote HWType
hwType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill Int
fillToN (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
elName) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
direction
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
hwType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
iE)
where
direction :: Mon (State VHDLState) Doc
direction | HWType -> Bool
isBiSignalIn HWType
hwType = Mon (State VHDLState) Doc
"inout"
| Bool
otherwise = Mon (State VHDLState) Doc
portDirection
iE :: Mon (State VHDLState) Doc
iE = Mon (State VHDLState) Doc
-> (Expr -> Mon (State VHDLState) Doc)
-> Maybe Expr
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
noEmptyInit (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Expr -> Mon (State VHDLState) Doc)
-> Expr
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) Maybe Expr
iEM
entity :: Component -> VHDLM Doc
entity :: Component -> Mon (State VHDLState) Doc
entity Component
c = do
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Int -> Mon (State VHDLState) [(Doc, Int)]
ports ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls))
Mon (State VHDLState) Doc
"entity" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
(case [Doc]
p of
[] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
[Doc]
_ -> case HdlSyn
syn of
HdlSyn
Other -> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
[Doc] -> f Doc
rports [Doc]
p Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> if [(Identifier, Attr')] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr')]
attrs then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else
Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
rattrs) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
HdlSyn
_ -> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
(Semigroup (f Doc), IsString (f Doc), Applicative f) =>
[Doc] -> f Doc
rports [Doc]
p) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
)
where
ports :: Int -> Mon (State VHDLState) [(Doc, Int)]
ports Int
l = [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)])
-> [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall a b. (a -> b) -> a -> b
$ [Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> Mon (State VHDLState) (Doc, Int)
forall t.
Num t =>
Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port Identifier
iName HWType
hwType Mon (State VHDLState) Doc
"in" Int
l Maybe Expr
forall a. Maybe a
Nothing | (Identifier
iName, HWType
hwType) <- Component -> [(Identifier, HWType)]
inputs Component
c]
[Mon (State VHDLState) (Doc, Int)]
-> [Mon (State VHDLState) (Doc, Int)]
-> [Mon (State VHDLState) (Doc, Int)]
forall a. [a] -> [a] -> [a]
++ [Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> Mon (State VHDLState) (Doc, Int)
forall t.
Num t =>
Identifier
-> HWType
-> Mon (State VHDLState) Doc
-> Int
-> Maybe Expr
-> VHDLM (Doc, t)
port Identifier
oName HWType
hwType Mon (State VHDLState) Doc
"out" Int
l Maybe Expr
iEM | (WireOrReg
_, (Identifier
oName, HWType
hwType), Maybe Expr
iEM) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c]
rports :: [Doc] -> f Doc
rports [Doc]
p = f Doc
"port" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> (f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (f [Doc] -> f Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (f Doc -> f [Doc] -> f [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate f Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> f [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p))))) f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
rattrs :: Mon (State VHDLState) Doc
rattrs = [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs [(Identifier, Attr')]
attrs
attrs :: [(Identifier, Attr')]
attrs = [(Identifier, Attr')]
inputAttrs [(Identifier, Attr')]
-> [(Identifier, Attr')] -> [(Identifier, Attr')]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr')]
outputAttrs
inputAttrs :: [(Identifier, Attr')]
inputAttrs = [(Identifier
id_, Attr'
attr) | (Identifier
id_, HWType
hwtype) <- Component -> [(Identifier, HWType)]
inputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
outputAttrs :: [(Identifier, Attr')]
outputAttrs = [(Identifier
id_, Attr'
attr) | (WireOrReg
_wireOrReg, (Identifier
id_, HWType
hwtype), Maybe Expr
_) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
architecture :: Component -> VHDLM Doc
architecture :: Component -> Mon (State VHDLState) Doc
architecture Component
c = do {
; HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
; let attrs :: [(Identifier, Attr')]
attrs = case HdlSyn
syn of
HdlSyn
Other -> [(Identifier, Attr')]
declAttrs
HdlSyn
_ -> [(Identifier, Attr')]
inputAttrs [(Identifier, Attr')]
-> [(Identifier, Attr')] -> [(Identifier, Attr')]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr')]
outputAttrs [(Identifier, Attr')]
-> [(Identifier, Attr')] -> [(Identifier, Attr')]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Attr')]
declAttrs
; Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
((Mon (State VHDLState) Doc
"architecture structural of" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"is" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
[Declaration] -> Mon (State VHDLState) Doc
decls (Component -> [Declaration]
declarations Component
c)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
if [(Identifier, Attr')] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Identifier, Attr')]
attrs then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs [(Identifier, Attr')]
attrs) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2
(Mon (State VHDLState) Doc
"begin" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
[Declaration] -> Mon (State VHDLState) Doc
insts (Component -> [Declaration]
declarations Component
c)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
}
where
netdecls :: [Declaration]
netdecls = (Declaration -> Bool) -> [Declaration] -> [Declaration]
forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isNetDecl (Component -> [Declaration]
declarations Component
c)
declAttrs :: [(Identifier, Attr')]
declAttrs = [(Identifier
id_, Attr'
attr) | NetDecl' Maybe Identifier
_ WireOrReg
_ Identifier
id_ (Right HWType
hwtype) Maybe Expr
_ <- [Declaration]
netdecls, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
inputAttrs :: [(Identifier, Attr')]
inputAttrs = [(Identifier
id_, Attr'
attr) | (Identifier
id_, HWType
hwtype) <- Component -> [(Identifier, HWType)]
inputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
outputAttrs :: [(Identifier, Attr')]
outputAttrs = [(Identifier
id_, Attr'
attr) | (WireOrReg
_wireOrReg, (Identifier
id_, HWType
hwtype), Maybe Expr
_) <- Component -> [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outputs Component
c, Attr'
attr <- HWType -> [Attr']
hwTypeAttrs HWType
hwtype]
isNetDecl :: Declaration -> Bool
isNetDecl :: Declaration -> Bool
isNetDecl (NetDecl' Maybe Identifier
_ WireOrReg
_ Identifier
_ (Right HWType
_) Maybe Expr
_) = Bool
True
isNetDecl Declaration
_ = Bool
False
attrType
:: t ~ HashMap T.Text T.Text
=> t
-> Attr'
-> t
attrType :: t -> Attr' -> t
attrType t
types Attr'
attr =
case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name' t
HashMap Text Text
types of
Maybe Text
Nothing -> Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
name' Text
type' t
HashMap Text Text
types
Just Text
type'' | Text
type'' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
type' -> t
types
| Bool
otherwise -> String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$
$(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ Text -> String
T.unpack Text
name', String
"already assigned"
, Text -> String
T.unpack Text
type'', String
"while we tried to"
, String
"add", Text -> String
T.unpack Text
type' ]
where
name' :: Text
name' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Attr' -> String
attrName Attr'
attr
type' :: Text
type' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ case Attr'
attr of
BoolAttr' String
_ Bool
_ -> String
"boolean"
IntegerAttr' String
_ FieldAnn
_ -> String
"integer"
StringAttr' String
_ String
_ -> String
"string"
Attr' String
_ -> String
"bool"
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
attrMap
:: forall t
. t ~ HashMap T.Text (T.Text, [(TextS.Text, T.Text)])
=> [(TextS.Text, Attr')]
-> t
attrMap :: [(Identifier, Attr')] -> t
attrMap [(Identifier, Attr')]
attrs = (t -> (Identifier, Attr') -> t) -> t -> [(Identifier, Attr')] -> t
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl t -> (Identifier, Attr') -> t
go t
HashMap Text (Text, [(Identifier, Text)])
empty' [(Identifier, Attr')]
attrs
where
empty' :: HashMap Text (Text, [(Identifier, Text)])
empty' = [(Text, (Text, [(Identifier, Text)]))]
-> HashMap Text (Text, [(Identifier, Text)])
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
[(Text
k, (HashMap Text Text
types HashMap Text Text -> Text -> Text
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! Text
k, [])) | Text
k <- HashMap Text Text -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Text
types]
types :: HashMap Text Text
types = [Attr'] -> HashMap Text Text
attrTypes (((Identifier, Attr') -> Attr') -> [(Identifier, Attr')] -> [Attr']
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, Attr') -> Attr'
forall a b. (a, b) -> b
snd [(Identifier, Attr')]
attrs)
go :: t -> (TextS.Text, Attr') -> t
go :: t -> (Identifier, Attr') -> t
go t
map' (Identifier, Attr')
attr = ((Text, [(Identifier, Text)]) -> (Text, [(Identifier, Text)]))
-> Text
-> HashMap Text (Text, [(Identifier, Text)])
-> HashMap Text (Text, [(Identifier, Text)])
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust
((Identifier, Attr')
-> (Text, [(Identifier, Text)]) -> (Text, [(Identifier, Text)])
go' (Identifier, Attr')
attr)
(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Attr' -> String
attrName (Attr' -> String) -> Attr' -> String
forall a b. (a -> b) -> a -> b
$ (Identifier, Attr') -> Attr'
forall a b. (a, b) -> b
snd (Identifier, Attr')
attr)
t
HashMap Text (Text, [(Identifier, Text)])
map'
go'
:: (TextS.Text, Attr')
-> (T.Text, [(TextS.Text, T.Text)])
-> (T.Text, [(TextS.Text, T.Text)])
go' :: (Identifier, Attr')
-> (Text, [(Identifier, Text)]) -> (Text, [(Identifier, Text)])
go' (Identifier
signalName, Attr'
attr) (Text
typ, [(Identifier, Text)]
elems) =
(Text
typ, (Identifier
signalName, Attr' -> Text
renderAttr Attr'
attr) (Identifier, Text) -> [(Identifier, Text)] -> [(Identifier, Text)]
forall a. a -> [a] -> [a]
: [(Identifier, Text)]
elems)
renderAttrs
:: [(TextS.Text, Attr')]
-> VHDLM Doc
renderAttrs :: [(Identifier, Attr')] -> Mon (State VHDLState) Doc
renderAttrs ([(Identifier, Attr')] -> HashMap Text (Text, [(Identifier, Text)])
forall t.
(t ~ HashMap Text (Text, [(Identifier, Text)])) =>
[(Identifier, Attr')] -> t
attrMap -> HashMap Text (Text, [(Identifier, Text)])
attrs) =
Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc])
-> [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. a -> [a] -> [a]
intersperse Mon (State VHDLState) Doc
" " ([Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc])
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> a -> b
$ ((Text, (Text, [(Identifier, Text)])) -> Mon (State VHDLState) Doc)
-> [(Text, (Text, [(Identifier, Text)]))]
-> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, [(Identifier, Text)])) -> Mon (State VHDLState) Doc
renderAttrGroup (HashMap Text (Text, [(Identifier, Text)])
-> [(Text, (Text, [(Identifier, Text)]))]
forall a b. (Eq a, Hashable a) => HashMap a b -> [(a, b)]
assocs HashMap Text (Text, [(Identifier, Text)])
attrs)
where
renderAttrGroup
:: (T.Text, (T.Text, [(TextS.Text, T.Text)]))
-> VHDLM Doc
renderAttrGroup :: (Text, (Text, [(Identifier, Text)])) -> Mon (State VHDLState) Doc
renderAttrGroup (Text
attrname, (Text
typ, [(Identifier, Text)]
elems)) =
(Mon (State VHDLState) Doc
"attribute" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
attrname Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
typ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
(Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc])
-> [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ ((Identifier, Text) -> Mon (State VHDLState) Doc)
-> [(Identifier, Text)] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> (Identifier, Text) -> Mon (State VHDLState) Doc
renderAttrDecl Text
attrname) [(Identifier, Text)]
elems)
renderAttrDecl
:: T.Text
-> (TextS.Text, T.Text)
-> VHDLM Doc
renderAttrDecl :: Text -> (Identifier, Text) -> Mon (State VHDLState) Doc
renderAttrDecl Text
attrname (Identifier
signalName, Text
value) =
Mon (State VHDLState) Doc
"attribute"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
attrname
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"of"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Identifier -> f Doc
stringS Identifier
signalName
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"signal is"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
value
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
assocs :: Eq a => Hashable a => HashMap a b -> [(a,b)]
assocs :: HashMap a b -> [(a, b)]
assocs HashMap a b
m = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
keys ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap a b
m HashMap a b -> a -> b
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.!) [a]
keys)
where
keys :: [a]
keys = (HashMap a b -> [a]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap a b
m)
renderAttr :: Attr' -> T.Text
renderAttr :: Attr' -> Text
renderAttr (StringAttr' String
_key String
value) = Text -> Text -> Text -> Text
T.replace Text
"\\\"" Text
"\"\"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
value
renderAttr (IntegerAttr' String
_key FieldAnn
value) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FieldAnn -> String
forall a. Show a => a -> String
show FieldAnn
value
renderAttr (BoolAttr' String
_key Bool
True ) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"true"
renderAttr (BoolAttr' String
_key Bool
False) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"false"
renderAttr (Attr' String
_key ) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"true"
sigDecl :: VHDLM Doc -> HWType -> VHDLM Doc
sigDecl :: Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
sigDecl Mon (State VHDLState) Doc
d HWType
t = Mon (State VHDLState) Doc
d Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
t
appendSize :: VHDLM Doc -> HWType -> VHDLM Doc
appendSize :: Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
appendSize Mon (State VHDLState) Doc
baseType HWType
sizedType = case HWType
sizedType of
BitVector Int
n -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
Signed Int
n -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
Unsigned Int
n -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto 0")
Vector Int
n HWType
_ -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"0 to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
RTree Int
d HWType
_ -> Mon (State VHDLState) Doc
baseType Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"0 to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ((Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
Annotated [Attr']
_ HWType
elTy -> Mon (State VHDLState) Doc -> HWType -> Mon (State VHDLState) Doc
appendSize Mon (State VHDLState) Doc
baseType HWType
elTy
HWType
_ -> Mon (State VHDLState) Doc
baseType
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
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
qualTyName :: HWType -> VHDLM Doc
qualTyName :: HWType -> Mon (State VHDLState) Doc
qualTyName (HWType -> HWType
filterTransparent -> HWType
hwty) = case HWType
hwty of
HWType
Bit -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
HWType
Bool -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Signed Int
_ -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
Unsigned Int
_ -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
BitVector Int
_ -> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
BiDirectional PortDirection
_ HWType
elTy -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy
Annotated [Attr']
_ HWType
elTy -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy
HWType
_ -> do
Identifier
modName <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm)
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
modName) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types." Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) Doc
tyName HWType
hwty
tyName
:: HWType
-> VHDLM Doc
tyName :: HWType -> Mon (State VHDLState) Doc
tyName HWType
t = do
Identifier
nm <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
False HWType
t
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm
tyName'
:: HasCallStack
=> Bool
-> HWType
-> VHDLM TextS.Text
tyName' :: Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 (HWType -> HWType
filterTransparent -> HWType
t) = do
State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((HashSet HWType -> Identity (HashSet HWType))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
-> VHDLState -> Identity VHDLState)
-> (HashSet HWType -> HashSet HWType) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HWType -> HashSet HWType -> HashSet HWType
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert HWType
t)
case HWType
t of
KnownDomain {} ->
Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Identifier
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Forced to print KnownDomain tyName"))
Void Maybe HWType
_ ->
Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Identifier
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Forced to print Void tyName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
t))
HWType
Bool -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"boolean"
Signed Int
n ->
let app :: [Identifier]
app = if Bool
rec0 then [Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n] else [] in
Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Mon (State VHDLState) Identifier)
-> Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
TextS.concat ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier
"signed" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
Unsigned Int
n ->
let app :: [Identifier]
app = if Bool
rec0 then [Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n] else [] in
Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Mon (State VHDLState) Identifier)
-> Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
TextS.concat ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier
"unsigned" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
BitVector Int
n ->
let app :: [Identifier]
app = if Bool
rec0 then [Identifier
"_", Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n] else [] in
Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Mon (State VHDLState) Identifier)
-> Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
TextS.concat ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier
"std_logic_vector" Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
app
HWType
String -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"string"
HWType
Integer -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"integer"
HWType
Bit -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"std_logic"
Vector Int
n HWType
elTy -> do
Identifier
elTy' <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
True HWType
elTy
let nm :: Identifier
nm = [Identifier] -> Identifier
TextS.concat [ Identifier
"array_of_"
, if Bool
rec0 then Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_" else Identifier
""
, Identifier
elTy']
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
rec0) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> State VHDLState Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
nm)
RTree Int
n HWType
elTy -> do
Identifier
elTy' <- HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
True HWType
elTy
let nm :: Identifier
nm = [Identifier] -> Identifier
TextS.concat [ Identifier
"tree_of_"
, if Bool
rec0 then Int -> Identifier
forall a. TextShow a => a -> Identifier
showt Int
n Identifier -> Identifier -> Identifier
`TextS.append` Identifier
"_" else Identifier
""
, Identifier
elTy']
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
rec0) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> State VHDLState Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
nm)
Index FieldAnn
n ->
Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier
"index_" Identifier -> Identifier -> Identifier
`TextS.append` FieldAnn -> Identifier
forall a. TextShow a => a -> Identifier
showt FieldAnn
n)
Clock Identifier
nm0 ->
let nm1 :: Identifier
nm1 = Identifier
"clk_" Identifier -> Identifier -> Identifier
`TextS.append` Identifier
nm0 in
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"clk" Identifier
nm1 HWType
t)
Reset Identifier
nm0 ->
let nm1 :: Identifier
nm1 = Identifier
"rst_" Identifier -> Identifier -> Identifier
`TextS.append` Identifier
nm0 in
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"rst" Identifier
nm1 HWType
t)
Sum Identifier
nm [Identifier]
_ ->
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sum" Identifier
nm HWType
t)
CustomSum Identifier
nm DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ ->
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sum" Identifier
nm HWType
t)
SP Identifier
nm [(Identifier, [HWType])]
_ ->
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sp" Identifier
nm HWType
t)
CustomSP Identifier
nm DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_ ->
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"sp" Identifier
nm HWType
t)
Product Identifier
nm Maybe [Identifier]
_ [HWType]
_ ->
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"product" Identifier
nm HWType
t)
CustomProduct Identifier
nm DataRepr'
_ Int
_ Maybe [Identifier]
_ [(FieldAnn, HWType)]
_ ->
State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ (HWType, Bool)
-> Lens' VHDLState (HashMap (HWType, Bool) Identifier)
-> State VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) k v.
(MonadState s m, Hashable k, Eq k) =>
k -> Lens' s (HashMap k v) -> m v -> m v
makeCached (HWType
t, Bool
False) Lens' VHDLState (HashMap (HWType, Bool) Identifier)
nameCache (Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
"product" Identifier
nm HWType
t)
Annotated [Attr']
_ HWType
hwTy ->
HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 HWType
hwTy
BiDirectional PortDirection
_ HWType
hwTy ->
HasCallStack => Bool -> HWType -> Mon (State VHDLState) Identifier
Bool -> HWType -> Mon (State VHDLState) Identifier
tyName' Bool
rec0 HWType
hwTy
HWType
FileType -> Identifier -> Mon (State VHDLState) Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
"file"
normaliseType :: HWType -> HWType
normaliseType :: HWType -> HWType
normaliseType HWType
hwty = case HWType
hwty of
Void {} -> HWType
hwty
KnownDomain {} -> HWType
hwty
HWType
Bool -> HWType
hwty
Signed Int
_ -> HWType
hwty
Unsigned Int
_ -> HWType
hwty
BitVector Int
_ -> HWType
hwty
HWType
String -> HWType
hwty
HWType
Integer -> HWType
hwty
HWType
Bit -> HWType
hwty
HWType
FileType -> HWType
hwty
Vector Int
_ HWType
_ -> HWType
hwty
RTree Int
_ HWType
_ -> HWType
hwty
Product Identifier
_ Maybe [Identifier]
_ [HWType]
_ -> HWType
hwty
Clock Identifier
_ -> HWType
Bit
Reset Identifier
_ -> HWType
Bit
Index FieldAnn
_ -> Int -> HWType
Unsigned (HWType -> Int
typeSize HWType
hwty)
CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_ -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
SP Identifier
_ [(Identifier, [HWType])]
_ -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
Sum Identifier
_ [Identifier]
_ -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
CustomProduct {} -> Int -> HWType
BitVector (HWType -> Int
typeSize HWType
hwty)
Annotated [Attr']
_ HWType
elTy -> HWType -> HWType
normaliseType HWType
elTy
BiDirectional PortDirection
_ HWType
elTy -> HWType -> HWType
normaliseType HWType
elTy
filterTransparent :: HWType -> HWType
filterTransparent :: HWType -> HWType
filterTransparent HWType
hwty = case HWType
hwty of
HWType
Bool -> HWType
hwty
Signed Int
_ -> HWType
hwty
Unsigned Int
_ -> HWType
hwty
BitVector Int
_ -> HWType
hwty
HWType
String -> HWType
hwty
HWType
Integer -> HWType
hwty
HWType
Bit -> HWType
hwty
Clock Identifier
_ -> HWType
hwty
Reset Identifier
_ -> HWType
hwty
Index FieldAnn
_ -> HWType
hwty
Sum Identifier
_ [Identifier]
_ -> HWType
hwty
CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_ -> HWType
hwty
HWType
FileType -> HWType
hwty
Vector Int
n HWType
elTy -> Int -> HWType -> HWType
Vector Int
n (HWType -> HWType
filterTransparent HWType
elTy)
RTree Int
n HWType
elTy -> Int -> HWType -> HWType
RTree Int
n (HWType -> HWType
filterTransparent HWType
elTy)
Product Identifier
nm Maybe [Identifier]
labels [HWType]
elTys ->
Identifier -> Maybe [Identifier] -> [HWType] -> HWType
Product Identifier
nm Maybe [Identifier]
labels ((HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
elTys)
SP Identifier
nm0 [(Identifier, [HWType])]
constrs ->
Identifier -> [(Identifier, [HWType])] -> HWType
SP Identifier
nm0
(((Identifier, [HWType]) -> (Identifier, [HWType]))
-> [(Identifier, [HWType])] -> [(Identifier, [HWType])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Identifier
nm1, [HWType]
tys) -> (Identifier
nm1, (HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
tys)) [(Identifier, [HWType])]
constrs)
CustomSP Identifier
nm0 DataRepr'
drepr Int
size [(ConstrRepr', Identifier, [HWType])]
constrs ->
Identifier
-> DataRepr'
-> Int
-> [(ConstrRepr', Identifier, [HWType])]
-> HWType
CustomSP Identifier
nm0 DataRepr'
drepr Int
size
(((ConstrRepr', Identifier, [HWType])
-> (ConstrRepr', Identifier, [HWType]))
-> [(ConstrRepr', Identifier, [HWType])]
-> [(ConstrRepr', Identifier, [HWType])]
forall a b. (a -> b) -> [a] -> [b]
map (\(ConstrRepr'
repr, Identifier
nm1, [HWType]
tys) -> (ConstrRepr'
repr, Identifier
nm1, (HWType -> HWType) -> [HWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> HWType
filterTransparent [HWType]
tys)) [(ConstrRepr', Identifier, [HWType])]
constrs)
CustomProduct Identifier
nm0 DataRepr'
drepr Int
size Maybe [Identifier]
maybeFieldNames [(FieldAnn, HWType)]
constrs ->
Identifier
-> DataRepr'
-> Int
-> Maybe [Identifier]
-> [(FieldAnn, HWType)]
-> HWType
CustomProduct Identifier
nm0 DataRepr'
drepr Int
size Maybe [Identifier]
maybeFieldNames
(((FieldAnn, HWType) -> (FieldAnn, HWType))
-> [(FieldAnn, HWType)] -> [(FieldAnn, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map ((HWType -> HWType) -> (FieldAnn, HWType) -> (FieldAnn, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second HWType -> HWType
filterTransparent) [(FieldAnn, HWType)]
constrs)
Annotated [Attr']
_ HWType
elTy -> HWType
elTy
BiDirectional PortDirection
_ HWType
elTy -> HWType
elTy
Void {} -> HWType
hwty
KnownDomain {} -> HWType
hwty
userTyName
:: Identifier
-> Identifier
-> HWType
-> StateT VHDLState Identity TextS.Text
userTyName :: Identifier -> Identifier -> HWType -> State VHDLState Identifier
userTyName Identifier
dflt Identifier
nm0 HWType
hwTy = do
(HashSet HWType -> Identity (HashSet HWType))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
-> VHDLState -> Identity VHDLState)
-> (HashSet HWType -> HashSet HWType) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HWType -> HashSet HWType -> HashSet HWType
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert HWType
hwTy
HashMap Identifier Word
seen <- Getting
(HashMap Identifier Word) VHDLState (HashMap Identifier Word)
-> StateT VHDLState Identity (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
(HashMap Identifier Word) VHDLState (HashMap Identifier Word)
Lens' VHDLState (HashMap Identifier Word)
tySeen
Identifier -> Identifier
mkId <- State VHDLState (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier State VHDLState (IdType -> Identifier -> Identifier)
-> StateT VHDLState Identity IdType
-> State VHDLState (Identifier -> Identifier)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> IdType -> StateT VHDLState Identity IdType
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdType
Basic
let nm1 :: Identifier
nm1 = (Identifier -> Identifier
mkId (Identifier -> Identifier)
-> (Identifier -> Identifier) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identifier] -> Identifier
forall a. [a] -> a
last ([Identifier] -> Identifier)
-> (Identifier -> [Identifier]) -> Identifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier -> [Identifier]
TextS.splitOn Identifier
".") Identifier
nm0
nm2 :: Identifier
nm2 = if Identifier -> Bool
TextS.null Identifier
nm1 then Identifier
dflt else Identifier
nm1
(Identifier
nm3,Word
count) = case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
nm2 HashMap Identifier Word
seen of
Just Word
cnt -> (Identifier -> Identifier)
-> HashMap Identifier Word
-> Word
-> Identifier
-> (Identifier, Word)
forall b t v.
(Show b, Num b) =>
t -> HashMap Identifier v -> b -> Identifier -> (Identifier, b)
go Identifier -> Identifier
mkId HashMap Identifier Word
seen Word
cnt Identifier
nm2
Maybe Word
Nothing -> (Identifier
nm2,Word
0)
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState
Lens' VHDLState (HashMap Identifier Word)
tySeen ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> VHDLState -> Identity VHDLState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
nm3 Word
count
Identifier -> State VHDLState Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
nm3
where
go :: t -> HashMap Identifier v -> b -> Identifier -> (Identifier, b)
go t
mkId HashMap Identifier v
seen b
count Identifier
nm0' =
let nm1' :: Identifier
nm1' = Identifier
nm0' Identifier -> Identifier -> Identifier
`TextS.append` String -> Identifier
TextS.pack (Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:b -> String
forall a. Show a => a -> String
show b
count) in
case Identifier -> HashMap Identifier v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
nm1' HashMap Identifier v
seen of
Just v
_ -> t -> HashMap Identifier v -> b -> Identifier -> (Identifier, b)
go t
mkId HashMap Identifier v
seen (b
countb -> b -> b
forall a. Num a => a -> a -> a
+b
1) Identifier
nm0'
Maybe v
Nothing -> (Identifier
nm1',b
countb -> b -> b
forall a. Num a => a -> a -> a
+b
1)
sizedQualTyNameErrValue :: HWType -> VHDLM Doc
sizedQualTyNameErrValue :: HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
Bool = do
Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
case Maybe (Maybe Int)
udf of
Just (Just Int
0) -> Mon (State VHDLState) Doc
"false"
Maybe (Maybe Int)
_ -> Mon (State VHDLState) Doc
"true"
sizedQualTyNameErrValue HWType
Bit = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue t :: HWType
t@(Vector Int
n HWType
elTy) = do
HdlSyn
syn <-State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
case HdlSyn
syn of
HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue))
HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(RTree Int
n HWType
elTy) = do
HdlSyn
syn <-State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
case HdlSyn
syn of
HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
elTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue))
HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
elTy)
sizedQualTyNameErrValue t :: HWType
t@(Product Identifier
_ Maybe [Identifier]
_ [HWType]
elTys) =
HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((HWType -> Mon (State VHDLState) Doc)
-> [HWType] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue [HWType]
elTys)
sizedQualTyNameErrValue (Reset {}) = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Clock Identifier
_) = Mon (State VHDLState) Doc
singularErrValue
sizedQualTyNameErrValue (Void {}) =
Doc -> Mon (State VHDLState) Doc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Doc
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[CLASH BUG] Forced to print Void error value"))
sizedQualTyNameErrValue HWType
String = Mon (State VHDLState) Doc
"\"ERROR\""
sizedQualTyNameErrValue HWType
t =
HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
singularErrValue)
singularErrValue :: VHDLM Doc
singularErrValue :: Mon (State VHDLState) Doc
singularErrValue = do
Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
case Maybe (Maybe Int)
udf of
Maybe (Maybe Int)
Nothing -> Mon (State VHDLState) Doc
"'-'"
Just Maybe Int
Nothing -> Mon (State VHDLState) Doc
"'0'"
Just (Just Int
x) -> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'"
vhdlRecSel
:: HWType
-> Int
-> VHDLM Doc
vhdlRecSel :: HWType -> Int -> Mon (State VHDLState) Doc
vhdlRecSel p :: HWType
p@(Product Identifier
_ Maybe [Identifier]
labels [HWType]
tys) Int
i =
HWType -> Mon (State VHDLState) Doc
tyName HWType
p Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
i
vhdlRecSel HWType
ty Int
i =
HWType -> Mon (State VHDLState) Doc
tyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_sel" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i
decls :: [Declaration] -> VHDLM Doc
decls :: [Declaration] -> Mon (State VHDLState) Doc
decls [] = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
decls [Declaration]
ds = do
rec ([Doc]
dsDoc,[Int]
ls) <- ([Maybe (Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [Maybe (Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Doc, Int)] -> ([Doc], [Int]))
-> ([Maybe (Doc, Int)] -> [(Doc, Int)])
-> [Maybe (Doc, Int)]
-> ([Doc], [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Doc, Int)] -> [(Doc, Int)]
forall a. [Maybe a] -> [a]
catMaybes) (Mon (State VHDLState) [Maybe (Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [Maybe (Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ (Declaration -> Mon (State VHDLState) (Maybe (Doc, Int)))
-> [Declaration] -> Mon (State VHDLState) [Maybe (Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Declaration -> Mon (State VHDLState) (Maybe (Doc, Int))
decl ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls)) [Declaration]
ds
case [Doc]
dsDoc of
[] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
[Doc]
_ -> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (m :: Type -> Type).
Monad m =>
Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
dsDoc)
decl :: Int -> Declaration -> VHDLM (Maybe (Doc,Int))
decl :: Int -> Declaration -> Mon (State VHDLState) (Maybe (Doc, Int))
decl Int
l (NetDecl' Maybe Identifier
noteM WireOrReg
_ Identifier
id_ Either Identifier HWType
ty Maybe Expr
iEM) = (Doc, Int) -> Maybe (Doc, Int)
forall a. a -> Maybe a
Just ((Doc, Int) -> Maybe (Doc, Int))
-> (Doc -> (Doc, Int)) -> Doc -> Maybe (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (,Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Identifier -> Int
TextS.length Identifier
id_)) (Doc -> Maybe (Doc, Int))
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) (Maybe (Doc, Int))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Identifier
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. a -> a
id Identifier
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Monoid (f Doc), Applicative f, IsString (f Doc), Pretty a) =>
a -> f Doc -> f Doc
addNote Maybe Identifier
noteM (Mon (State VHDLState) Doc
"signal" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill Int
l (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (Identifier -> Mon (State VHDLState) Doc)
-> (HWType -> Mon (State VHDLState) Doc)
-> Either Identifier HWType
-> Mon (State VHDLState) Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty HWType -> Mon (State VHDLState) Doc
sizedQualTyName Either Identifier HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
iE)
where
addNote :: a -> f Doc -> f Doc
addNote a
n = f Doc -> f Doc -> f Doc
forall a. Monoid a => a -> a -> a
mappend (f Doc
"--" f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> a -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty a
n f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
line)
iE :: Mon (State VHDLState) Doc
iE = Mon (State VHDLState) Doc
-> (Expr -> Mon (State VHDLState) Doc)
-> Maybe Expr
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
noEmptyInit (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Expr -> Mon (State VHDLState) Doc)
-> Expr
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) Maybe Expr
iEM
decl Int
_ (InstDecl EntityOrComponent
Comp Maybe Identifier
_ Identifier
nm Identifier
_ [(Expr, HWType, Expr)]
gens [(Expr, PortDirection, HWType, Expr)]
pms) = (Doc -> Maybe (Doc, Int))
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) (Maybe (Doc, Int))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc, Int) -> Maybe (Doc, Int)
forall a. a -> Maybe a
Just ((Doc, Int) -> Maybe (Doc, Int))
-> (Doc -> (Doc, Int)) -> Doc -> Maybe (Doc, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Int
0)) (Mon (State VHDLState) Doc
-> Mon (State VHDLState) (Maybe (Doc, Int)))
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) (Maybe (Doc, Int))
forall a b. (a -> b) -> a -> b
$ do
{ rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (,Expr -> Int
forall p. Num p => Expr -> p
formalLength Expr
i) (Doc -> (Doc, Int))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
i) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> PortDirection -> Mon (State VHDLState) Doc
forall p. IsString p => PortDirection -> p
portDir PortDirection
dir Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
sizedQualTyName HWType
ty | (Expr
i,PortDirection
dir,HWType
ty,Expr
_) <- [(Expr, PortDirection, HWType, Expr)]
pms ]
; rec ([Doc]
g,[Int]
lsg) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (,Expr -> Int
forall p. Num p => Expr -> p
formalLength Expr
i) (Doc -> (Doc, Int))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
lsg) (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
i) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Mon (State VHDLState) Doc
tyName HWType
ty | (Expr
i,HWType
ty,Expr
_) <- [(Expr, HWType, Expr)]
gens]
; Mon (State VHDLState) Doc
"component" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
( if [Doc] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
g then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
else Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"generic" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f [Doc] -> f Doc
tupledSemi ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
g) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
)
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Mon (State VHDLState) Doc
"port" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f [Doc] -> f Doc
tupledSemi ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"end component"
}
where
formalLength :: Expr -> p
formalLength (Identifier Identifier
i Maybe Modifier
_) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Identifier -> Int
TextS.length Identifier
i)
formalLength Expr
_ = p
0
portDir :: PortDirection -> p
portDir PortDirection
In = p
"in"
portDir PortDirection
Out = p
"out"
decl Int
_ Declaration
_ = Maybe (Doc, Int) -> Mon (State VHDLState) (Maybe (Doc, Int))
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (Doc, Int)
forall a. Maybe a
Nothing
noEmptyInit :: VHDLM Doc -> VHDLM Doc
noEmptyInit :: Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
noEmptyInit Mon (State VHDLState) Doc
d = do
Doc
d1 <- Mon (State VHDLState) Doc
d
if Doc -> Bool
isEmpty Doc
d1
then Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
else (Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
space Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
":=" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
d)
stdMatch
:: Bits a
=> Int
-> a
-> a
-> String
stdMatch :: Int -> a -> a -> String
stdMatch Int
0 a
_mask a
_value = []
stdMatch Int
size a
mask a
value =
Char
symbol Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> a -> a -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
mask a
value
where
symbol :: Char
symbol =
if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
mask (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
value (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then
Char
'1'
else
Char
'0'
else
Char
'-'
patLitCustom'
:: Bits a
=> VHDLM Doc
-> Int
-> a
-> a
-> VHDLM Doc
patLitCustom' :: Mon (State VHDLState) Doc
-> Int -> a -> a -> Mon (State VHDLState) Doc
patLitCustom' Mon (State VHDLState) Doc
var Int
size a
mask a
value =
let mask' :: Mon (State VHDLState) Doc
mask' = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon (State VHDLState) Doc)
-> Text -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> String
forall a. Bits a => Int -> a -> a -> String
stdMatch Int
size a
mask a
value in
Mon (State VHDLState) Doc
"std_match" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes Mon (State VHDLState) Doc
mask' Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
var)
patLitCustom
:: VHDLM Doc
-> HWType
-> Literal
-> VHDLM Doc
patLitCustom :: Mon (State VHDLState) Doc
-> HWType -> Literal -> Mon (State VHDLState) Doc
patLitCustom Mon (State VHDLState) Doc
var (CustomSum Identifier
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Identifier)]
reprs) (NumLit (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i)) =
Mon (State VHDLState) Doc
-> Int -> FieldAnn -> FieldAnn -> Mon (State VHDLState) Doc
forall a.
Bits a =>
Mon (State VHDLState) Doc
-> Int -> a -> a -> Mon (State VHDLState) Doc
patLitCustom' Mon (State VHDLState) Doc
var Int
size FieldAnn
mask FieldAnn
value
where
((ConstrRepr' Identifier
_name Int
_n FieldAnn
mask FieldAnn
value [FieldAnn]
_anns), Identifier
_id) = [(ConstrRepr', Identifier)]
reprs [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i
patLitCustom Mon (State VHDLState) Doc
var (CustomSP Identifier
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Identifier, [HWType])]
reprs) (NumLit (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i)) =
Mon (State VHDLState) Doc
-> Int -> FieldAnn -> FieldAnn -> Mon (State VHDLState) Doc
forall a.
Bits a =>
Mon (State VHDLState) Doc
-> Int -> a -> a -> Mon (State VHDLState) Doc
patLitCustom' Mon (State VHDLState) Doc
var Int
size FieldAnn
mask FieldAnn
value
where
((ConstrRepr' Identifier
_name Int
_n FieldAnn
mask FieldAnn
value [FieldAnn]
_anns), Identifier
_id, [HWType]
_tys) = [(ConstrRepr', Identifier, [HWType])]
reprs [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
i
patLitCustom Mon (State VHDLState) Doc
_ HWType
x Literal
y = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
[ String
"You can only pass CustomSP / CustomSum and a NumLit to this function,"
, String
"not", HWType -> String
forall a. Show a => a -> String
show HWType
x, String
"and", Literal -> String
forall a. Show a => a -> String
show Literal
y]
insts :: [Declaration] -> VHDLM Doc
insts :: [Declaration] -> Mon (State VHDLState) Doc
insts [] = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl Identifier
id_:[Declaration]
ds) = Identifier -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
Identifier -> Identifier -> f Doc
comment Identifier
"--" Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
insts (Declaration
d:[Declaration]
ds) = do
Maybe Doc
d' <- Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_ Declaration
d
case Maybe Doc
d' of
Just Doc
doc -> Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
Maybe Doc
_ -> [Declaration] -> Mon (State VHDLState) Doc
insts [Declaration]
ds
inst_' :: TextS.Text -> Expr -> HWType -> [(Maybe Literal, Expr)] -> VHDLM (Maybe Doc)
inst_' :: Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Mon (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es = (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
(Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
esNub) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi))
where
esMod :: [(Maybe Literal, Expr)]
esMod = ((Maybe Literal, Expr) -> (Maybe Literal, Expr))
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Literal -> Maybe Literal)
-> (Maybe Literal, Expr) -> (Maybe Literal, Expr)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HWType -> Literal -> Literal
patMod HWType
scrutTy))) [(Maybe Literal, Expr)]
es
esNub :: [(Maybe Literal, Expr)]
esNub = ((Maybe Literal, Expr) -> (Maybe Literal, Expr) -> Bool)
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Maybe Literal -> Maybe Literal -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Literal -> Maybe Literal -> Bool)
-> ((Maybe Literal, Expr) -> Maybe Literal)
-> (Maybe Literal, Expr)
-> (Maybe Literal, Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Literal, Expr) -> Maybe Literal
forall a b. (a, b) -> a
fst) [(Maybe Literal, Expr)]
esMod
var :: Mon (State VHDLState) Doc
var = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True Expr
scrut
conds :: [(Maybe Literal,Expr)] -> VHDLM [Doc]
conds :: [(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [] = [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds [(Maybe Literal
_,Expr
e)] = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_) = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
-> HWType -> Literal -> Mon (State VHDLState) Doc
patLitCustom Mon (State VHDLState) Doc
var HWType
scrutTy Literal
c
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"else"
Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
es'
inst_ :: Declaration -> VHDLM (Maybe Doc)
inst_ :: Declaration -> Mon (State VHDLState) (Maybe Doc)
inst_ (Assignment Identifier
id_ Expr
e) = (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut HWType
_ [(Just (BoolLit Bool
b), Expr
l),(Maybe Literal
_,Expr
r)]) = (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vsep ([Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
scrut Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"else"
,HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
f Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
]))
where
(Expr
t,Expr
f) = if Bool
b then (Expr
l,Expr
r) else (Expr
r,Expr
l)
inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_) [(Maybe Literal, Expr)]
es) =
Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Mon (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es
inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
_) [(Maybe Literal, Expr)]
es) =
Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Mon (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es
inst_ (CondAssignment Identifier
id_ HWType
_ Expr
scrut scrutTy :: HWType
scrutTy@(CustomProduct Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ [(FieldAnn, HWType)]
_) [(Maybe Literal, Expr)]
es) =
Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Mon (State VHDLState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es
inst_ (CondAssignment Identifier
id_ HWType
_sig Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es) = (Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Mon (State VHDLState) Doc
"with" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True Expr
scrut) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"select" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
larrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma ([(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
esNub)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi))
where
esMod :: [(Maybe Literal, Expr)]
esMod = ((Maybe Literal, Expr) -> (Maybe Literal, Expr))
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Literal -> Maybe Literal)
-> (Maybe Literal, Expr) -> (Maybe Literal, Expr)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (HWType -> Literal -> Literal
patMod HWType
scrutTy))) [(Maybe Literal, Expr)]
es
esNub :: [(Maybe Literal, Expr)]
esNub = ((Maybe Literal, Expr) -> (Maybe Literal, Expr) -> Bool)
-> [(Maybe Literal, Expr)] -> [(Maybe Literal, Expr)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Maybe Literal -> Maybe Literal -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Literal -> Maybe Literal -> Bool)
-> ((Maybe Literal, Expr) -> Maybe Literal)
-> (Maybe Literal, Expr)
-> (Maybe Literal, Expr)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Literal, Expr) -> Maybe Literal
forall a b. (a, b) -> a
fst) [(Maybe Literal, Expr)]
esMod
conds :: [(Maybe Literal,Expr)] -> VHDLM [Doc]
conds :: [(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [] = [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds [(Maybe Literal
_,Expr
e)] = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"others" Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_) = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"others" Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"when" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Literal -> Mon (State VHDLState) Doc
patLit HWType
scrutTy Literal
c Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [(Maybe Literal, Expr)] -> Mon (State VHDLState) [Doc]
conds [(Maybe Literal, Expr)]
es'
inst_ (InstDecl EntityOrComponent
entOrComp Maybe Identifier
libM Identifier
nm Identifier
lbl [(Expr, HWType, Expr)]
gens [(Expr, PortDirection, HWType, Expr)]
pms) = do
Mon (State VHDLState) ()
-> (Identifier -> Mon (State VHDLState) ())
-> Maybe Identifier
-> Mon (State VHDLState) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Mon (State VHDLState) ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) (\Identifier
lib -> State VHDLState () -> Mon (State VHDLState) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState
Lens' VHDLState [Text]
libraries (([Text] -> Identity [Text]) -> VHDLState -> Identity VHDLState)
-> ([Text] -> [Text]) -> State VHDLState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Identifier -> Text
T.fromStrict Identifier
libText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))) Maybe Identifier
libM
(Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
lbl Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
entOrComp'
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
-> (Identifier -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc ((Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
".") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Identifier -> Mon (State VHDLState) Doc)
-> Identifier
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
libM Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
gms Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
pms' Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
where
gms :: Mon (State VHDLState) Doc
gms | [] <- [(Expr, HWType, Expr)]
gens = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
| Bool
otherwise = do
rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (,Expr -> Int
forall p. Num p => Expr -> p
formalLength Expr
i) (Doc -> (Doc, Int))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
i) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"=>" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e | (Expr
i,HWType
_,Expr
e) <- [(Expr, HWType, Expr)]
gens]
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (Mon (State VHDLState) Doc
"generic map" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
pms' :: Mon (State VHDLState) Doc
pms' = do
rec ([Doc]
p,[Int]
ls) <- ([(Doc, Int)] -> ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int]))
-> Mon (State VHDLState) [(Doc, Int)]
-> Mon (State VHDLState) ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) (Doc, Int)]
-> Mon (State VHDLState) [(Doc, Int)]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ (,Expr -> Int
forall p. Num p => Expr -> p
formalLength Expr
i) (Doc -> (Doc, Int))
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Doc, Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc -> f Doc
fill ([Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls) (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
i) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"=>" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e | (Expr
i,PortDirection
_,HWType
_,Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms]
Int -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
"port map" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Doc]
p)
formalLength :: Expr -> p
formalLength (Identifier Identifier
i Maybe Modifier
_) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Identifier -> Int
TextS.length Identifier
i)
formalLength Expr
_ = p
0
entOrComp' :: Mon (State VHDLState) Doc
entOrComp' = case EntityOrComponent
entOrComp of { EntityOrComponent
Entity -> Mon (State VHDLState) Doc
" entity"; EntityOrComponent
Comp -> Mon (State VHDLState) Doc
" component"; EntityOrComponent
Empty -> Mon (State VHDLState) Doc
""}
inst_ (BlackBoxD Identifier
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx) =
(Doc -> Maybe Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (State VHDLState Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (StateT VHDLState Identity (Int -> Doc) -> State VHDLState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx)))
inst_ Declaration
_ = Maybe Doc -> Mon (State VHDLState) (Maybe Doc)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing
customReprDataCon
:: DataRepr'
-> ConstrRepr'
-> [(HWType, Expr)]
-> VHDLM Doc
customReprDataCon :: DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
constrRepr [(HWType, Expr)]
args =
Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ (BitOrigin -> Mon (State VHDLState) Doc)
-> [BitOrigin] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BitOrigin -> Mon (State VHDLState) Doc
range [BitOrigin]
origins)
where
DataRepr' Type'
_typ Int
size [ConstrRepr']
_constrs = DataRepr'
dataRepr
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]
origins :: [BitOrigin]
origins = DataRepr' -> ConstrRepr' -> [BitOrigin]
bitOrigins DataRepr'
dataRepr ConstrRepr'
constrRepr :: [BitOrigin]
range
:: BitOrigin
-> VHDLM Doc
range :: BitOrigin -> Mon (State VHDLState) Doc
range (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (Bit -> Mon (State VHDLState) Doc)
-> [Bit] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Bit -> Mon (State VHDLState) Doc
bit_char [Bit]
ns
range (Field Int
n Int
start Int
end) =
let fsize :: Int
fsize = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in
let expr' :: Mon (State VHDLState) Doc
expr' = [Mon (State VHDLState) Doc]
argSLVs [Mon (State VHDLState) Doc] -> Int -> Mon (State VHDLState) Doc
forall a. [a] -> Int -> a
!! Int
n in
let unsigned :: Mon (State VHDLState) Doc
unsigned = Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
expr') in
if | Int
fsize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size ->
Mon (State VHDLState) Doc
expr'
| Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
let resized :: Mon (State VHDLState) Doc
resized = Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
unsigned Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize) in
Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
resized
| Bool
otherwise ->
let rotated :: Mon (State VHDLState) Doc
rotated = Mon (State VHDLState) Doc
unsigned Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"srl" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end in
let resized :: Mon (State VHDLState) Doc
resized = Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
rotated Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fsize) in
Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
resized
expr_
:: HasCallStack
=> Bool
-> Expr
-> VHDLM Doc
expr_ :: Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
_ (Literal Maybe (HWType, Int)
sizeM Literal
lit) = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
sizeM Literal
lit
expr_ Bool
_ (Identifier Identifier
id_ Maybe Modifier
Nothing) = Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
expr_ Bool
_ (Identifier Identifier
id_ (Just Modifier
m)) = do
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
Mon (State VHDLState) Doc
-> ([(VHDLModifier, HWType)] -> Mon (State VHDLState) Doc)
-> Maybe [(VHDLModifier, HWType)]
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) (((VHDLModifier, HWType)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc
-> [(VHDLModifier, HWType)]
-> Mon (State VHDLState) Doc
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (VHDLModifier, HWType)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
renderModifier (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)) (HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [] Modifier
m)
expr_ Bool
b (DataCon HWType
_ (DC (Void {}, -1)) [Expr
e]) = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
b Expr
e
expr_ Bool
_ (DataCon ty :: HWType
ty@(Vector Int
0 HWType
_) Modifier
_ [Expr]
_) = HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue HWType
ty
expr_ Bool
_ (DataCon ty :: HWType
ty@(Vector Int
1 HWType
elTy) Modifier
_ [Expr
e]) = do
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
case HdlSyn
syn of
HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
elTy Expr
e)
HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
expr_ Bool
_ e :: Expr
e@(DataCon ty :: HWType
ty@(Vector Int
_ HWType
elTy) Modifier
_ [Expr
e1,Expr
e2]) = do
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
case HdlSyn
syn of
HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> case Expr -> Maybe [Expr]
vectorChain Expr
e of
Just [Expr]
es -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
elTy) [Expr]
es))
Maybe [Expr]
Nothing -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
elTy Expr
e1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"&" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e2)
HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> case Expr -> Maybe [Expr]
vectorChain Expr
e of
Just [Expr]
es -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) [Expr]
es))
Maybe [Expr]
Nothing -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> Mon (State VHDLState) Doc
qualTyName HWType
elTy Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"&" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e2)
expr_ Bool
_ (DataCon ty :: HWType
ty@(RTree Int
0 HWType
elTy) Modifier
_ [Expr
e]) = do
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
case HdlSyn
syn of
HdlSyn
Vivado -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
elTy Expr
e)
HdlSyn
_ -> HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
expr_ Bool
_ e :: Expr
e@(DataCon ty :: HWType
ty@(RTree Int
d HWType
elTy) Modifier
_ [Expr
e1,Expr
e2]) = HWType -> Mon (State VHDLState) Doc
qualTyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> case Expr -> Maybe [Expr]
rtreeChain Expr
e of
Just [Expr]
es -> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ((Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) [Expr]
es)
Maybe [Expr]
Nothing -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> Mon (State VHDLState) Doc
qualTyName (Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
elTy) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e1) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
Mon (State VHDLState) Doc
"&" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e2)
expr_ Bool
_ (DataCon (SP {}) (DC (BitVector Int
_,Int
_)) [Expr]
es) = Mon (State VHDLState) Doc
assignExpr
where
argExprs :: [Mon (State VHDLState) Doc]
argExprs = (Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> (Expr -> Mon (State VHDLState) Doc)
-> Expr
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) [Expr]
es
assignExpr :: Mon (State VHDLState) Doc
assignExpr = Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Doc]
argExprs)
expr_ Bool
_ (DataCon ty :: HWType
ty@(SP Identifier
_ [(Identifier, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = Mon (State VHDLState) Doc
assignExpr
where
argTys :: [HWType]
argTys = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])]
args [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
i
dcSize :: Int
dcSize = HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((HWType -> Int) -> [HWType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Int
typeSize [HWType]
argTys)
dcExpr :: Mon (State VHDLState) Doc
dcExpr = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
argExprs :: [Mon (State VHDLState) Doc]
argExprs = (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a b. (a -> b) -> [a] -> [b]
map Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> [Mon (State VHDLState) Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType]
argTys [Expr]
es)
extraArg :: [Mon (State VHDLState) Doc]
extraArg = case HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dcSize of
Int
0 -> []
Int
n -> [[Bit] -> Mon (State VHDLState) Doc
bits (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
assignExpr :: Mon (State VHDLState) Doc
assignExpr = Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc])
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall a b. (a -> b) -> a -> b
$ [Mon (State VHDLState) Doc] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Mon (State VHDLState) Doc
dcExprMon (State VHDLState) Doc
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. a -> [a] -> [a]
:[Mon (State VHDLState) Doc]
argExprs [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Doc]
forall a. [a] -> [a] -> [a]
++ [Mon (State VHDLState) Doc]
extraArg))
expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum Identifier
_ [Identifier]
_) (DC (HWType
_,Int
i)) []) =
HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
expr_ Bool
_ (DataCon ty :: HWType
ty@(CustomSum Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier)]
tys) (DC (HWType
_,Int
i)) []) =
let (ConstrRepr' Identifier
_ Int
_ FieldAnn
_ FieldAnn
value [FieldAnn]
_) = (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
tys [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i in
Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldAnn
value) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty)))
expr_ Bool
_ (DataCon (CustomSP Identifier
_ DataRepr'
dataRepr Int
_size [(ConstrRepr', Identifier, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) =
let (ConstrRepr'
cRepr, Identifier
_, [HWType]
argTys) = [(ConstrRepr', Identifier, [HWType])]
args [(ConstrRepr', Identifier, [HWType])]
-> Int -> (ConstrRepr', Identifier, [HWType])
forall a. [a] -> Int -> a
!! Int
i in
DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
argTys [Expr]
es)
expr_ Bool
_ (DataCon (CustomProduct Identifier
_ DataRepr'
dataRepr Int
_size Maybe [Identifier]
_labels [(FieldAnn, HWType)]
tys) Modifier
_ [Expr]
es) |
DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
DataRepr'
-> ConstrRepr' -> [(HWType, Expr)] -> Mon (State VHDLState) Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. [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_ Bool
_ (DataCon ty :: HWType
ty@(Product Identifier
_ Maybe [Identifier]
labels [HWType]
tys) Modifier
_ [Expr]
es) =
Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ (Int -> Expr -> Mon (State VHDLState) Doc)
-> [Int] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i Expr
e' -> HWType -> Mon (State VHDLState) Doc
tyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
rarrow Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e') [Int
0..] [Expr]
es
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"Clash.Sized.Internal.Signed.fromInteger#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
= Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) Literal
i
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"Clash.Sized.Internal.Unsigned.fromInteger#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
= Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) Literal
i
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"Clash.Sized.Internal.BitVector.fromInteger#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
= let NumLit FieldAnn
m' = Literal
m
NumLit FieldAnn
i' = Literal
i
in Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n),FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
n)) (FieldAnn -> FieldAnn -> Literal
BitVecLit FieldAnn
m' FieldAnn
i')
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"Clash.Sized.Internal.BitVector.fromInteger##"
, [Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
= let NumLit FieldAnn
m' = Literal
m
NumLit FieldAnn
i' = Literal
i
in Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
Bit,Int
1)) (Bit -> Literal
BitLit (Bit -> Literal) -> Bit -> Literal
forall a b. (a -> b) -> a -> b
$ FieldAnn -> FieldAnn -> Bit
toBit FieldAnn
m' FieldAnn
i')
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"Clash.Sized.Internal.Index.fromInteger#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
, Just Int
k <- FieldAnn -> FieldAnn -> Maybe Int
clogBase FieldAnn
2 FieldAnn
n
, let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
= Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
k',Int
k')) Literal
i
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"Clash.Sized.Internal.Index.maxBound#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
, FieldAnn
n FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
> FieldAnn
0
, Just Int
k <- FieldAnn -> FieldAnn -> Maybe Int
clogBase FieldAnn
2 FieldAnn
n
, let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
= Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
k',Int
k')) (FieldAnn -> Literal
NumLit (FieldAnn
nFieldAnn -> FieldAnn -> FieldAnn
forall a. Num a => a -> a -> a
-FieldAnn
1))
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"GHC.Types.I#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
= do Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed Int
iw,Int
iw)) (FieldAnn -> Literal
NumLit FieldAnn
n)
expr_ Bool
_ (BlackBoxE Identifier
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
| Identifier
pNm Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"GHC.Types.W#"
, [Literal Maybe (HWType, Int)
_ (NumLit FieldAnn
n)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
= do Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned Int
iw,Int
iw)) (FieldAnn -> Literal
NumLit FieldAnn
n)
expr_ Bool
b (BlackBoxE Identifier
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx Bool
b') = do
Bool -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (m :: Type -> Type).
Monad m =>
Bool -> Mon m Doc -> Mon m Doc
parenIf (Bool
b Bool -> Bool -> Bool
|| Bool
b') (State VHDLState Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> StateT VHDLState Identity (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx StateT VHDLState Identity (Int -> Doc)
-> State VHDLState Int -> State VHDLState Doc
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Int -> State VHDLState Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0))
expr_ Bool
_ (DataTag HWType
Bool (Left Identifier
id_)) = Mon (State VHDLState) Doc
"tagToEnum" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)
expr_ Bool
_ (DataTag HWType
Bool (Right Identifier
id_)) = Mon (State VHDLState) Doc
"dataToTag" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)
expr_ Bool
_ (DataTag hty :: HWType
hty@(Sum Identifier
_ [Identifier]
_) (Left Identifier
id_)) =
Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
hty)))
expr_ Bool
_ (DataTag (Sum Identifier
_ [Identifier]
_) (Right Identifier
id_)) = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))
expr_ Bool
_ (DataTag (Product {}) (Right Identifier
_)) = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag hty :: HWType
hty@(SP Identifier
_ [(Identifier, [HWType])]
_) (Right Identifier
id_)) = do {
; Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
; Mon (State VHDLState) Doc
"signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (
Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)))
}
where
start :: Int
start = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = HWType -> Int
typeSize HWType
hty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
hty
expr_ Bool
_ (DataTag (Vector Int
0 HWType
_) (Right Identifier
_)) = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag (Vector Int
_ HWType
_) (Right Identifier
_)) = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag (RTree Int
0 HWType
_) (Right Identifier
_)) = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (DataTag (RTree Int
_ HWType
_) (Right Identifier
_)) = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Int -> Mon (State VHDLState) Int)
-> State VHDLState Int -> Mon (State VHDLState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth
Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
expr_ Bool
_ (ConvBV Maybe Identifier
topM HWType
hwty Bool
True Expr
e) = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
case Maybe Identifier
topM of
Maybe Identifier
Nothing -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> Mon (State VHDLState) Doc
qualTyName HWType
hwty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e))
Just Identifier
t -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
expr_ Bool
_ (ConvBV Maybe Identifier
topM HWType
_ Bool
False Expr
e) = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Mon (State VHDLState) Doc
-> (Identifier -> Mon (State VHDLState) Doc)
-> Maybe Identifier
-> Mon (State VHDLState) Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types" ) (\Identifier
t -> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types") Maybe Identifier
topM Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc
"fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
expr_ Bool
_ Expr
e = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr -> String
forall a. Show a => a -> String
show Expr
e)
otherSize :: [HWType] -> Int -> Int
otherSize :: [HWType] -> Int -> Int
otherSize [HWType]
_ Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int
0
otherSize [] Int
_ = Int
0
otherSize (HWType
a:[HWType]
as) Int
n = HWType -> Int
typeSize HWType
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [HWType] -> Int -> Int
otherSize [HWType]
as (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
vectorChain :: Expr -> Maybe [Expr]
vectorChain :: Expr -> Maybe [Expr]
vectorChain (DataCon (Vector Int
0 HWType
_) Modifier
_ [Expr]
_) = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just []
vectorChain (DataCon (Vector Int
1 HWType
_) Modifier
_ [Expr
e]) = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just [Expr
e]
vectorChain (DataCon (Vector Int
_ HWType
_) Modifier
_ [Expr
e1,Expr
e2]) = Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e1 Maybe Expr -> Maybe [Expr] -> Maybe [Expr]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Expr -> Maybe [Expr]
vectorChain Expr
e2
vectorChain Expr
_ = Maybe [Expr]
forall a. Maybe a
Nothing
rtreeChain :: Expr -> Maybe [Expr]
rtreeChain :: Expr -> Maybe [Expr]
rtreeChain (DataCon (RTree Int
1 HWType
_) Modifier
_ [Expr
e]) = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just [Expr
e]
rtreeChain (DataCon (RTree Int
_ HWType
_) Modifier
_ [Expr
e1,Expr
e2]) = ([Expr] -> [Expr] -> [Expr])
-> Maybe [Expr] -> Maybe [Expr] -> Maybe [Expr]
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
(++) (Expr -> Maybe [Expr]
rtreeChain Expr
e1) (Expr -> Maybe [Expr]
rtreeChain Expr
e2)
rtreeChain Expr
_ = Maybe [Expr]
forall a. Maybe a
Nothing
exprLit :: Maybe (HWType,Size) -> Literal -> VHDLM Doc
exprLit :: Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
Nothing (NumLit FieldAnn
i) = FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i
exprLit (Just (HWType
hty,Int
sz)) (NumLit FieldAnn
i) = case HWType
hty of
Unsigned Int
n
| FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< (-FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer)) -> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"signed'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit))
| FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
0 -> Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens(FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)))
| FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer) -> Mon (State VHDLState) Doc
"to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
| Bool
otherwise -> Mon (State VHDLState) Doc
"unsigned'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
Signed Int
n
| FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer) Bool -> Bool -> Bool
&& FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
> (-FieldAnn
2FieldAnn -> FieldAnn -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(FieldAnn
31 :: Integer)) -> Mon (State VHDLState) Doc
"to_signed" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (FieldAnn -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => FieldAnn -> f Doc
integer FieldAnn
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
| Bool
otherwise -> Mon (State VHDLState) Doc
"signed'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
BitVector Int
_ -> Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
lit
HWType
Bit -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a. Num a => FieldAnn -> a
fromInteger FieldAnn
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2))
HWType
_ -> Mon (State VHDLState) Doc
blit
where
validHexLit :: Bool
validHexLit = Int
sz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
lit :: Mon (State VHDLState) Doc
lit = if Bool
validHexLit then Mon (State VHDLState) Doc
hlit else Mon (State VHDLState) Doc
blit
blit :: Mon (State VHDLState) Doc
blit = [Bit] -> Mon (State VHDLState) Doc
bits (Int -> FieldAnn -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz FieldAnn
i)
i' :: FieldAnn
i' = case HWType
hty of
Signed Int
_ -> let mask :: FieldAnn
mask = FieldAnn
2FieldAnn -> Int -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) in case FieldAnn -> FieldAnn -> (FieldAnn, FieldAnn)
forall a. Integral a => a -> a -> (a, a)
divMod FieldAnn
i FieldAnn
mask of
(FieldAnn
s,FieldAnn
i'') | FieldAnn -> Bool
forall a. Integral a => a -> Bool
even FieldAnn
s -> FieldAnn
i''
| Bool
otherwise -> FieldAnn
i'' FieldAnn -> FieldAnn -> FieldAnn
forall a. Num a => a -> a -> a
- FieldAnn
mask
HWType
_ -> FieldAnn
i FieldAnn -> FieldAnn -> FieldAnn
forall a. Integral a => a -> a -> a
`mod` FieldAnn
2FieldAnn -> Int -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz
hlit :: Mon (State VHDLState) Doc
hlit = (if FieldAnn
i' FieldAnn -> FieldAnn -> Bool
forall a. Ord a => a -> a -> Bool
< FieldAnn
0 then Mon (State VHDLState) Doc
"-" else Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> String -> Mon (State VHDLState) Doc
hex (Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i')
exprLit (Just (HWType
hty,Int
sz)) (BitVecLit FieldAnn
m FieldAnn
i) = case FieldAnn
m of
FieldAnn
0 -> Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
hty,Int
sz)) (FieldAnn -> Literal
NumLit FieldAnn
i)
FieldAnn
_ -> Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
bvlit
where
bvlit :: Mon (State VHDLState) Doc
bvlit = [Bit] -> Mon (State VHDLState) Doc
bits (Int -> FieldAnn -> FieldAnn -> [Bit]
forall a. Integral a => Int -> a -> a -> [Bit]
toBits' Int
sz FieldAnn
m FieldAnn
i)
exprLit Maybe (HWType, Int)
_ (BoolLit Bool
t) = if Bool
t then Mon (State VHDLState) Doc
"true" else Mon (State VHDLState) Doc
"false"
exprLit Maybe (HWType, Int)
_ (BitLit Bit
b) = Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc -> f Doc
squotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Bit -> Mon (State VHDLState) Doc
bit_char Bit
b
exprLit Maybe (HWType, Int)
_ (StringLit String
s) = Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Text -> Mon (State VHDLState) Doc)
-> (String -> Text) -> String -> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
s
exprLit Maybe (HWType, Int)
_ Literal
l = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"exprLit: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Literal -> String
forall a. Show a => a -> String
show Literal
l
patLit :: HWType -> Literal -> VHDLM Doc
patLit :: HWType -> Literal -> Mon (State VHDLState) Doc
patLit HWType
Bit (NumLit FieldAnn
i) = if FieldAnn
i FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
0 then Mon (State VHDLState) Doc
"'0'" else Mon (State VHDLState) Doc
"'1'"
patLit HWType
hwTy (NumLit FieldAnn
i) =
let sz :: Int
sz = HWType -> Int
conSize HWType
hwTy
in case Int
sz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 of
Int
0 -> String -> Mon (State VHDLState) Doc
hex (Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i)
Int
_ -> [Bit] -> Mon (State VHDLState) Doc
bits (Int -> FieldAnn -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
toBits Int
sz FieldAnn
i)
patLit HWType
_ Literal
l = Maybe (HWType, Int) -> Literal -> Mon (State VHDLState) Doc
exprLit Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
l
patMod :: HWType -> Literal -> Literal
patMod :: HWType -> Literal -> Literal
patMod HWType
hwTy (NumLit FieldAnn
i) = FieldAnn -> Literal
NumLit (FieldAnn
i FieldAnn -> FieldAnn -> FieldAnn
forall a. Integral a => a -> a -> a
`mod` (FieldAnn
2 FieldAnn -> Int -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^ HWType -> Int
typeSize HWType
hwTy))
patMod HWType
_ Literal
l = Literal
l
toBits :: Integral a => Int -> a -> [Bit]
toBits :: Int -> a -> [Bit]
toBits Int
size a
val = (a -> Bit) -> [a] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
forall a. Integral a => a -> Bool
odd a
x then Bit
H else Bit
L)
([a] -> [Bit]) -> [a] -> [Bit]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
size
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2)
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a
val
toBits' :: Integral a => Int -> a -> a -> [Bit]
toBits' :: Int -> a -> a -> [Bit]
toBits' Int
size a
msk a
val = ((a, a) -> Bit) -> [(a, a)] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
m,a
i) -> if a -> Bool
forall a. Integral a => a -> Bool
odd a
m then Bit
U else (if a -> Bool
forall a. Integral a => a -> Bool
odd a
i then Bit
H else Bit
L))
([(a, a)] -> [Bit]) -> [(a, a)] -> [Bit]
forall a b. (a -> b) -> a -> b
$
( [(a, a)] -> [(a, a)]
forall a. [a] -> [a]
reverse ([(a, a)] -> [(a, a)])
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, a)] -> [(a, a)]
forall a. Int -> [a] -> [a]
take Int
size)
([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
( (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a
msk)
( (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a
val)
bits :: [Bit] -> VHDLM Doc
bits :: [Bit] -> Mon (State VHDLState) Doc
bits = Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> ([Bit] -> Mon (State VHDLState) Doc)
-> [Bit]
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> ([Bit] -> Mon (State VHDLState) [Doc])
-> [Bit]
-> Mon (State VHDLState) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Mon (State VHDLState) Doc)
-> [Bit] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Bit -> Mon (State VHDLState) Doc
bit_char
toHex :: Int -> Integer -> String
toHex :: Int -> FieldAnn -> String
toHex Int
sz FieldAnn
i =
let Just Int
d = FieldAnn -> FieldAnn -> Maybe Int
clogBase FieldAnn
16 (FieldAnn
2FieldAnn -> Int -> FieldAnn
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz)
in String -> FieldAnn -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"X") (FieldAnn -> FieldAnn
forall a. Num a => a -> a
abs FieldAnn
i)
hex :: String -> VHDLM Doc
hex :: String -> Mon (State VHDLState) Doc
hex String
s = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'x' Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
dquotes (Text -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (String -> Text
T.pack String
s))
bit_char :: Bit -> VHDLM Doc
bit_char :: Bit -> Mon (State VHDLState) Doc
bit_char Bit
H = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'1'
bit_char Bit
L = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'0'
bit_char Bit
U = do
Maybe (Maybe Int)
udf <- State VHDLState (Maybe (Maybe Int))
-> Mon (State VHDLState) (Maybe (Maybe Int))
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
-> State VHDLState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) VHDLState (Maybe (Maybe Int))
Lens' VHDLState (Maybe (Maybe Int))
undefValue)
case Maybe (Maybe Int)
udf of
Maybe (Maybe Int)
Nothing -> Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'-'
Just Maybe Int
Nothing -> Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'0'
Just (Just Int
i) -> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'"
bit_char Bit
Z = Char -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'Z'
toSLV :: HasCallStack => HWType -> Expr -> VHDLM Doc
toSLV :: HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
Bool Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV HWType
Bit Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Clock {}) Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Reset {}) Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (BitVector Int
_) Expr
e = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
True Expr
e
toSLV (Signed Int
_) Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Unsigned Int
_) Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Index FieldAnn
_) Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Sum Identifier
_ [Identifier]
_) Expr
e = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV (CustomSum Identifier
_ DataRepr'
_dataRepr Int
size [(ConstrRepr', Identifier)]
reprs) (DataCon HWType
_ (DC (HWType
_,Int
i)) [Expr]
_) =
let (ConstrRepr' Identifier
_ Int
_ FieldAnn
_ FieldAnn
value [FieldAnn]
_) = (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Identifier) -> ConstrRepr')
-> (ConstrRepr', Identifier) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Identifier)]
reprs [(ConstrRepr', Identifier)] -> Int -> (ConstrRepr', Identifier)
forall a. [a] -> Int -> a
!! Int
i in
let unsigned :: Mon (State VHDLState) Doc
unsigned = Mon (State VHDLState) Doc
"to_unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (FieldAnn -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FieldAnn
value) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
size) in
Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
unsigned
toSLV (CustomSum {}) Expr
e = Mon (State VHDLState) Doc
"std_logic_vector" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV t :: HWType
t@(Product Identifier
_ Maybe [Identifier]
labels [HWType]
tys) (Identifier Identifier
id_ Maybe Modifier
Nothing) = do
[Expr]
selIds' <- [Mon (State VHDLState) Expr] -> Mon (State VHDLState) [Expr]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Expr]
selIds
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc]
-> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen Mon (State VHDLState) Doc
" & " ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType]
tys [Expr]
selIds')
where
tName :: Mon (State VHDLState) Doc
tName = HWType -> Mon (State VHDLState) Doc
tyName HWType
t
selNames :: [Mon (State VHDLState) Identifier]
selNames = (Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier)
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) ) [Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
tName Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
i | Int
i <- [Int
0..([HWType] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
tys)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
selIds :: [Mon (State VHDLState) Expr]
selIds = (Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr)
-> [Mon (State VHDLState) Identifier]
-> [Mon (State VHDLState) Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Expr)
-> Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Identifier
n -> Identifier -> Maybe Modifier -> Expr
Identifier Identifier
n Maybe Modifier
forall a. Maybe a
Nothing)) [Mon (State VHDLState) Identifier]
selNames
toSLV (Product Identifier
_ Maybe [Identifier]
_ [HWType]
tys) (DataCon HWType
_ Modifier
_ [Expr]
es) | [HWType] -> [Expr] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [HWType]
tys [Expr]
es =
Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc]
-> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen Mon (State VHDLState) Doc
" & " ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType]
tys [Expr]
es)
toSLV (CustomProduct Identifier
_ DataRepr'
_ Int
_ Maybe [Identifier]
_ [(FieldAnn, HWType)]
_) Expr
e = do
HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV t :: HWType
t@(Product Identifier
_ Maybe [Identifier]
_ [HWType]
_) Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e))
toSLV (SP Identifier
_ [(Identifier, [HWType])]
_) Expr
e = HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV (CustomSP Identifier
_ DataRepr'
_ Int
_ [(ConstrRepr', Identifier, [HWType])]
_) Expr
e =
HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e
toSLV (Vector Int
n HWType
elTy) (Identifier Identifier
id_ Maybe Modifier
Nothing) = do
[Expr]
selIds' <- [Mon (State VHDLState) Expr] -> Mon (State VHDLState) [Expr]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Mon (State VHDLState) Expr]
selIds
HdlSyn
syn <- State VHDLState HdlSyn -> Mon (State VHDLState) HdlSyn
forall (f :: Type -> Type) m. f m -> Mon f m
Mon State VHDLState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & "
(case HdlSyn
syn of
HdlSyn
Vivado -> (Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False) [Expr]
selIds'
HdlSyn
_ -> (Expr -> Mon (State VHDLState) Doc)
-> [Expr] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV HWType
elTy) [Expr]
selIds'))
where
selNames :: [Mon (State VHDLState) Identifier]
selNames = (Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier)
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Identifier)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Identifier
T.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) ) ([Mon (State VHDLState) Doc] -> [Mon (State VHDLState) Identifier])
-> [Mon (State VHDLState) Doc]
-> [Mon (State VHDLState) Identifier]
forall a b. (a -> b) -> a -> b
$ [Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i) | Int
i <- [Int
0 .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]]
selIds :: [Mon (State VHDLState) Expr]
selIds = (Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr)
-> [Mon (State VHDLState) Identifier]
-> [Mon (State VHDLState) Expr]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> Expr)
-> Mon (State VHDLState) Identifier -> Mon (State VHDLState) Expr
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identifier -> Maybe Modifier -> Expr
`Identifier` Maybe Modifier
forall a. Maybe a
Nothing)) [Mon (State VHDLState) Identifier]
selNames
toSLV (Vector Int
_ HWType
_) e :: Expr
e@(DataCon HWType
_ (DC (Void Maybe HWType
Nothing, -1)) [Expr]
_) = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (Vector Int
n HWType
elTy) (DataCon HWType
_ Modifier
_ [Expr]
es) =
Mon (State VHDLState) Doc
"std_logic_vector'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " ((HWType -> Expr -> Mon (State VHDLState) Doc)
-> [HWType] -> [Expr] -> Mon (State VHDLState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HasCallStack => HWType -> Expr -> Mon (State VHDLState) Doc
HWType -> Expr -> Mon (State VHDLState) Doc
toSLV [HWType
elTy,Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
elTy] [Expr]
es))
toSLV (Vector Int
_ HWType
_) Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (State VHDLState Identifier -> Mon (State VHDLState) Identifier)
-> State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall a b. (a -> b) -> a -> b
$ Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV (RTree Int
_ HWType
_) Expr
e = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm)
Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.toSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (HasCallStack => Bool -> Expr -> Mon (State VHDLState) Doc
Bool -> Expr -> Mon (State VHDLState) Doc
expr_ Bool
False Expr
e)
toSLV HWType
hty Expr
e = String -> Mon (State VHDLState) Doc
forall a. HasCallStack => String -> a
error (String -> Mon (State VHDLState) Doc)
-> String -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"toSLV:\n\nType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
hty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nExpression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
dcToExpr :: HWType -> Int -> Expr
dcToExpr :: HWType -> Int -> Expr
dcToExpr HWType
ty Int
i = Maybe (HWType, Int) -> Literal -> Expr
Literal ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
ty,HWType -> Int
conSize HWType
ty)) (FieldAnn -> Literal
NumLit (Int -> FieldAnn
forall a. Integral a => a -> FieldAnn
toInteger Int
i))
larrow :: VHDLM Doc
larrow :: Mon (State VHDLState) Doc
larrow = Mon (State VHDLState) Doc
"<="
rarrow :: VHDLM Doc
rarrow :: Mon (State VHDLState) Doc
rarrow = Mon (State VHDLState) Doc
"=>"
parenIf :: Monad m => Bool -> Mon m Doc -> Mon m Doc
parenIf :: Bool -> Mon m Doc -> Mon m Doc
parenIf Bool
True = Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
parenIf Bool
False = Mon m Doc -> Mon m Doc
forall a. a -> a
id
punctuate' :: Monad m => Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' :: Mon m Doc -> Mon m [Doc] -> Mon m Doc
punctuate' Mon m Doc
s Mon m [Doc]
d = Mon m [Doc] -> Mon m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Mon m Doc -> Mon m [Doc] -> Mon m [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon m Doc
s Mon m [Doc]
d) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
s
encodingNote :: HWType -> VHDLM Doc
encodingNote :: HWType -> Mon (State VHDLState) Doc
encodingNote (Clock Identifier
_) = Mon (State VHDLState) Doc
"-- clock" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (Reset Identifier
_ ) = Mon (State VHDLState) Doc
"-- reset" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
encodingNote (Annotated [Attr']
_ HWType
t) = HWType -> Mon (State VHDLState) Doc
encodingNote HWType
t
encodingNote HWType
_ = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
tupledSemi :: Applicative f => f [Doc] -> f Doc
tupledSemi :: f [Doc] -> f Doc
tupledSemi = f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (f Doc -> f Doc) -> (f [Doc] -> f Doc) -> f [Doc] -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep (f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
flatAlt (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc) f Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen)
(f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
flatAlt (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen) f Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen)
(f Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi f Doc -> f Doc -> f Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc)
data VHDLModifier
= Range Range
| Idx Int
| Slice Int Int
| Select (VHDLM Doc)
| Resize
| ResizeAndConvert
| DontCare
buildModifier
:: HasCallStack
=> HdlSyn
-> [(VHDLModifier,HWType)]
-> Modifier
-> Maybe [(VHDLModifier,HWType)]
buildModifier :: HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Sliced (HWType
_,Int
start,Int
end)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
hty Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous Int
start Int
end),HWType
hty) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
where
hty :: HWType
hty = Int -> HWType
BitVector (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(SP Identifier
_ [(Identifier, [HWType])]
args),Int
dcI,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous Int
start Int
end),HWType
argTy) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
where
argTys :: [HWType]
argTys = (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd (String -> [(Identifier, [HWType])] -> Int -> (Identifier, [HWType])
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"SOP type: invalid constructor index" [(Identifier, [HWType])]
args Int
dcI)
argTy :: HWType
argTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"SOP type: invalid field index" [HWType]
argTys Int
fI
argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
other :: Int
other = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
other
end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Product Identifier
_ Maybe [Identifier]
labels [HWType]
tys),Int
_,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
otherSz :: Int
otherSz = [HWType] -> Int -> Int
otherSize [HWType]
tys (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
otherSz
end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
let d :: Mon (State VHDLState) Doc
d = Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> Mon (State VHDLState) Doc
tyName HWType
ty Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> HasCallStack =>
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
Maybe [Identifier] -> [HWType] -> Int -> Mon (State VHDLState) Doc
selectProductField Maybe [Identifier]
labels [HWType]
tys Int
fI
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Mon (State VHDLState) Doc -> VHDLModifier
Select Mon (State VHDLState) Doc
d,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
where
argTy :: HWType
argTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Product type: invalid field index" [HWType]
tys Int
fI
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
1,Int
0)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
start Int
_,Vector Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
start,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
0,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM))
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Vector Int
n HWType
argTy),Int
1,Int
1)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
start Int
end,Vector Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end,HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
where
tyN :: HWType
tyN = Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
_ HWType
argTy),Int
0,Int
0)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
start Int
_,RTree Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
start,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
0,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM))
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
0)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
start Int
_,RTree Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
start (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
0 (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
where
tyN :: HWType
tyN = Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy
z :: Int
z = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
1)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
0)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
_ Int
end,RTree Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end,HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Int -> Int -> VHDLModifier
Slice Int
z (Int
z'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),HWType
tyN) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
where
tyN :: HWType
tyN = Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy
z :: Int
z = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
z' :: Int
z' = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
10,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
argSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
start Int
_,Vector Int
_ HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI),HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy (((Int -> VHDLModifier
Idx Int
fI,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)))
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(RTree Int
_ HWType
argTy),Int
10,Int
fI)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
let argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
fI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
argSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
argSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
| (Slice Int
start Int
_,RTree Int
1 HWType
argTyP) <- (VHDLModifier, HWType)
prev
, HWType
argTy HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
argTyP ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI),HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
rest))
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just (HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
argTy ((Int -> VHDLModifier
Idx Int
fI,HWType
argTy)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM))
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (CustomSP Identifier
_ DataRepr'
dataRepr Int
size [(ConstrRepr', Identifier, [HWType])]
args,Int
dcI,Int
fI))
| Void {} <- HWType
argTy
= String -> Maybe [(VHDLModifier, HWType)]
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
| Bool
otherwise
= case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy (Int -> Int -> Range
Contiguous (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0)) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
prevM)
where
(ConstrRepr' Identifier
_name Int
_n FieldAnn
_mask FieldAnn
_value [FieldAnn]
anns, Identifier
_, [HWType]
argTys) =
String
-> [(ConstrRepr', Identifier, [HWType])]
-> Int
-> (ConstrRepr', Identifier, [HWType])
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid constructor index" [(ConstrRepr', Identifier, [HWType])]
args Int
dcI
ses :: [(Int, Int)]
ses = FieldAnn -> [(Int, Int)]
bitRanges (String -> [FieldAnn] -> Int -> FieldAnn
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid annotation index" [FieldAnn]
anns Int
fI)
argTy :: HWType
argTy = String -> [HWType] -> Int -> HWType
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom SOP type: invalid field index" [HWType]
argTys Int
fI
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (CustomProduct Identifier
_ DataRepr'
dataRepr Int
size Maybe [Identifier]
_ [(FieldAnn, HWType)]
args,Int
dcI,Int
fI))
| Void {} <- HWType
argTy
= String -> Maybe [(VHDLModifier, HWType)]
forall a. HasCallStack => String -> a
error (DataRepr' -> Int -> Int -> String
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
| DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr
, ConstrRepr' Identifier
_cName Int
_pos FieldAnn
_mask FieldAnn
_val [FieldAnn]
fieldAnns <- ConstrRepr'
cRepr
, let ses :: [(Int, Int)]
ses = FieldAnn -> [(Int, Int)]
bitRanges (String -> [FieldAnn] -> Int -> FieldAnn
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom product type: invalid annotation index"
[FieldAnn]
fieldAnns Int
fI)
= case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int, Int)]
ses HWType
argTy (Int -> Int -> Range
Contiguous (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0))(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
where
argTy :: HWType
argTy = (FieldAnn, HWType) -> HWType
forall a b. (a, b) -> b
snd (String -> [(FieldAnn, HWType)] -> Int -> (FieldAnn, HWType)
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote String
"Custom product type: invalid field index" [(FieldAnn, HWType)]
args Int
fI)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (DC (ty :: HWType
ty@(SP Identifier
_ [(Identifier, [HWType])]
_),Int
_)) = case [(VHDLModifier, HWType)]
prevM of
((VHDLModifier, HWType)
prev:[(VHDLModifier, HWType)]
rest)
| (Range Range
r,HWType
_) <- (VHDLModifier, HWType)
prev ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier)
-> (Range, HWType) -> (VHDLModifier, HWType)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Range -> VHDLModifier
Range ([(Int, Int)] -> HWType -> Range -> (Range, HWType)
continueWithRange [(Int
start,Int
end)] HWType
tyN Range
r) (VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
: [(VHDLModifier, HWType)]
rest)
[(VHDLModifier, HWType)]
_ ->
[(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous Int
start Int
end),HWType
tyN)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
where
start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- HWType -> Int
conSize HWType
ty
tyN :: HWType
tyN = Int -> HWType
BitVector (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM (Nested Modifier
m1 Modifier
m2) = case HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM Modifier
m1 of
Maybe [(VHDLModifier, HWType)]
Nothing -> HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM Modifier
m2
Just [(VHDLModifier, HWType)]
prevM1 -> case HasCallStack =>
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
HdlSyn
-> [(VHDLModifier, HWType)]
-> Modifier
-> Maybe [(VHDLModifier, HWType)]
buildModifier HdlSyn
syn [(VHDLModifier, HWType)]
prevM1 Modifier
m2 of
Maybe [(VHDLModifier, HWType)]
Nothing -> [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just [(VHDLModifier, HWType)]
prevM1
Maybe [(VHDLModifier, HWType)]
m -> Maybe [(VHDLModifier, HWType)]
m
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Signed Int
_),Int
_,Int
_)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
Resize,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(Unsigned Int
_),Int
_,Int
_)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
Resize,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(BitVector Int
_),Int
_,Int
0)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
DontCare,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
prevM (Indexed (ty :: HWType
ty@(BitVector Int
_),Int
_,Int
1)) = [(VHDLModifier, HWType)] -> Maybe [(VHDLModifier, HWType)]
forall a. a -> Maybe a
Just ((VHDLModifier
ResizeAndConvert,HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
prevM)
buildModifier HdlSyn
_ [(VHDLModifier, HWType)]
_ Modifier
_ = Maybe [(VHDLModifier, HWType)]
forall a. Maybe a
Nothing
vivadoRange
:: HdlSyn
-> HWType
-> [(VHDLModifier, HWType)]
-> [(VHDLModifier, HWType)]
vivadoRange :: HdlSyn
-> HWType -> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
vivadoRange HdlSyn
syn HWType
ty [(VHDLModifier, HWType)]
mods = case HdlSyn
syn of
HdlSyn
Vivado -> (Range -> VHDLModifier
Range (Int -> Int -> Range
Contiguous (HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0),HWType
ty)(VHDLModifier, HWType)
-> [(VHDLModifier, HWType)] -> [(VHDLModifier, HWType)]
forall a. a -> [a] -> [a]
:[(VHDLModifier, HWType)]
mods
HdlSyn
_ -> [(VHDLModifier, HWType)]
mods
renderModifier
:: (VHDLModifier,HWType)
-> VHDLM Doc
-> VHDLM Doc
renderModifier :: (VHDLModifier, HWType)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
renderModifier (Idx Int
n,HWType
_) Mon (State VHDLState) Doc
doc = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n)
renderModifier (Slice Int
start Int
end,HWType
_) Mon (State VHDLState) Doc
doc = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"to" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
renderModifier (Select Mon (State VHDLState) Doc
sel,HWType
_) Mon (State VHDLState) Doc
doc = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
sel
renderModifier (VHDLModifier
Resize,HWType
ty) Mon (State VHDLState) Doc
doc = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth)
Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< HWType -> Int
typeSize HWType
ty) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
renderModifier (VHDLModifier
ResizeAndConvert,HWType
ty) Mon (State VHDLState) Doc
doc = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth)
Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< HWType -> Int
typeSize HWType
ty) ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: result smaller than argument") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
Mon (State VHDLState) Doc
"resize" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) Doc
"unsigned" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"," Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw)
renderModifier (VHDLModifier
DontCare,HWType
_) Mon (State VHDLState) Doc
_ = do
Int
iw <- State VHDLState Int -> Mon (State VHDLState) Int
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Int VHDLState Int -> State VHDLState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int VHDLState Int
Lens' VHDLState Int
intWidth)
Bool
-> String -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Bool -> String -> a -> a
traceIf Bool
True ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"WARNING: rendering bitvector mask as dontcare") (Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc)
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a b. (a -> b) -> a -> b
$
HWType -> Mon (State VHDLState) Doc
sizedQualTyNameErrValue (Int -> HWType
Unsigned Int
iw)
renderModifier (Range Range
r,HWType
t) Mon (State VHDLState) Doc
doc = do
Identifier
nm <- State VHDLState Identifier -> Mon (State VHDLState) Identifier
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting Identifier VHDLState Identifier
-> State VHDLState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier VHDLState Identifier
Lens' VHDLState Identifier
modNm)
let doc1 :: Mon (State VHDLState) Doc
doc1 = case Range
r of
Contiguous Int
start Int
end -> Int -> Int -> Mon (State VHDLState) Doc
slice Int
start Int
end
Split [(Int, Int, Provenance)]
rs -> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Mon (State VHDLState) [Doc] -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon (State VHDLState) Doc
-> Mon (State VHDLState) [Doc] -> Mon (State VHDLState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon (State VHDLState) Doc
" & " (((Int, Int, Provenance) -> Mon (State VHDLState) Doc)
-> [(Int, Int, Provenance)] -> Mon (State VHDLState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
s,Int
e,Provenance
_) -> Int -> Int -> Mon (State VHDLState) Doc
slice Int
s Int
e) [(Int, Int, Provenance)]
rs)))
case HWType -> HWType
normaliseType HWType
t of
BitVector Int
_ -> Mon (State VHDLState) Doc
doc1
HWType
_ ->
HWType -> Mon (State VHDLState) Doc
qualTyName HWType
t Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"'" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<>
Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> Mon (State VHDLState) Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Identifier -> Identifier
TextS.toLower Identifier
nm) Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc
"_types.fromSLV" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens Mon (State VHDLState) Doc
doc1)
where
slice :: Int -> Int -> Mon (State VHDLState) Doc
slice Int
s Int
e = Mon (State VHDLState) Doc
doc Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall a. Semigroup a => a -> a -> a
<> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Mon (State VHDLState) Doc
"downto" Mon (State VHDLState) Doc
-> Mon (State VHDLState) Doc -> Mon (State VHDLState) Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon (State VHDLState) Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)