{-|
  Copyright   :  (C) 2015-2016, University of Twente,
                     2017-2018, Google Inc.,
                     2021-2024, QBayLogic B.V.,
                     2022     , Google Inc.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

  Generate SystemVerilog for assorted Netlist datatypes
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TemplateHaskell #-}

module Clash.Backend.SystemVerilog (SystemVerilogState) where

import qualified Control.Applicative                  as A
import           Control.Lens                         hiding (Indexed)
import           Control.Monad                        (forM,liftM,zipWithM)
import           Control.Monad.State                  (State)
import           Data.Bifunctor                       (first)
import           Data.Bits                            (Bits, testBit)
import qualified Data.ByteString.Char8                as B8
import           Data.Coerce                          (coerce)
import           Data.Function                        (on)
import           Data.HashMap.Lazy                    (HashMap)
import qualified Data.HashMap.Lazy                    as HashMap
import           Data.HashSet                         (HashSet)
import qualified Data.HashSet                         as HashSet
import           Data.List                            (nub, nubBy)
import           Data.List.Extra                      ((<:>), zipEqual)
import           Data.Maybe                           (catMaybes,fromMaybe,mapMaybe)
import           Data.Monoid                          (Ap(Ap))
import           Data.Monoid.Extra                    ()
import qualified Data.Text.Lazy                       as Text
import qualified Data.Text                            as TextS
import           Data.Text.Prettyprint.Doc.Extra
import qualified Data.Text.Prettyprint.Doc.Extra      as PP
import qualified System.FilePath

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.Annotations.SynthesisAttributes (Attr(..))
import           Clash.Debug                          (traceIf)
import           Clash.Backend
import           Clash.Backend.Verilog
  (bits, bit_char, encodingNote, exprLit, include, noEmptyInit, uselibs)
import           Clash.Backend.Verilog.Time           (periodToString)
import           Clash.Driver.Types                   (ClashOpts(..))
import           Clash.Explicit.BlockRam.Internal     (unpackNats)
import           Clash.Netlist.BlackBox.Types         (HdlSyn (..))
import           Clash.Netlist.BlackBox.Util
  (extractLiterals, renderBlackBox, renderFilePath)
import qualified Clash.Netlist.Id                     as Id
import           Clash.Netlist.Types                  hiding (intWidth, usages, _usages)
import           Clash.Netlist.Util
import           Clash.Signal.Internal                (ActiveEdge (..))
import           Clash.Util
  (SrcSpan, clogBase, noSrcSpan, curLoc, makeCached, indexNote)
import           Clash.Util.Graph                     (reverseTopSort)

-- | State for the 'Clash.Backend.SystemVerilog.SystemVerilogM' monad:
data SystemVerilogState =
  SystemVerilogState
    { SystemVerilogState -> HashSet HWType
_tyCache   :: HashSet HWType -- ^ Previously encountered  HWTypes
    , SystemVerilogState -> HashMap HWType Identifier
_nameCache :: HashMap HWType Identifier -- ^ Cache for previously generated product type names
    , SystemVerilogState -> Int
_genDepth  :: Int -- ^ Depth of current generative block
    , SystemVerilogState -> Text
_modNm     :: ModName
    , SystemVerilogState -> Identifier
_topNm     :: Identifier
    , SystemVerilogState -> IdentifierSet
_idSeen    :: IdentifierSet
    , SystemVerilogState -> [Identifier]
_oports    :: [Identifier]
    , SystemVerilogState -> SrcSpan
_srcSpan   :: SrcSpan
    , SystemVerilogState -> [([Char], Doc)]
_includes  :: [(String,Doc)]
    , SystemVerilogState -> [Text]
_imports   :: [Text.Text]
    , SystemVerilogState -> [Text]
_libraries :: [Text.Text]
    , SystemVerilogState -> [([Char], [Char])]
_dataFiles      :: [(String,FilePath)]
    -- ^ Files to be copied: (filename, old path)
    , SystemVerilogState -> [([Char], [Char])]
_memoryDataFiles:: [(String,String)]
    -- ^ Files to be stored: (filename, contents). These files are generated
    -- during the execution of 'genNetlist'.
    , SystemVerilogState -> Bool
_tyPkgCtx  :: Bool
    -- ^ Are we in the context of generating the @_types@  package?
    , SystemVerilogState -> Int
_intWidth  :: Int -- ^ Int/Word/Integer bit-width
    , SystemVerilogState -> HdlSyn
_hdlsyn    :: HdlSyn
    , SystemVerilogState -> Maybe (Maybe Int)
_undefValue :: Maybe (Maybe Int)
    , SystemVerilogState -> AggressiveXOptBB
_aggressiveXOptBB_ :: AggressiveXOptBB
    , SystemVerilogState -> RenderEnums
_renderEnums_ :: RenderEnums
    , SystemVerilogState -> DomainMap
_domainConfigurations_ :: DomainMap
    , SystemVerilogState -> UsageMap
_usages :: UsageMap
    }

makeLenses ''SystemVerilogState

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

instance HasUsageMap SystemVerilogState where
  usageMap :: Lens' SystemVerilogState UsageMap
usageMap = (UsageMap -> f UsageMap)
-> SystemVerilogState -> f SystemVerilogState
Lens' SystemVerilogState UsageMap
usages

instance Backend SystemVerilogState where
  initBackend :: ClashOpts -> SystemVerilogState
initBackend ClashOpts
opts = SystemVerilogState
    { _tyCache :: HashSet HWType
_tyCache=HashSet HWType
forall a. HashSet a
HashSet.empty
    , _nameCache :: HashMap HWType Identifier
_nameCache=HashMap HWType Identifier
forall k v. HashMap k v
HashMap.empty
    , _genDepth :: Int
_genDepth=Int
0
    , _modNm :: Text
_modNm=Text
""
    , _topNm :: Identifier
_topNm=HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake Text
""
    , _idSeen :: IdentifierSet
_idSeen=Bool -> PreserveCase -> HDL -> IdentifierSet
Id.emptyIdentifierSet (ClashOpts -> Bool
opt_escapedIds ClashOpts
opts) (ClashOpts -> PreserveCase
opt_lowerCaseBasicIds ClashOpts
opts) HDL
SystemVerilog
    , _oports :: [Identifier]
_oports=[]
    , _srcSpan :: SrcSpan
_srcSpan=SrcSpan
noSrcSpan
    , _includes :: [([Char], Doc)]
_includes=[]
    , _imports :: [Text]
_imports=[]
    , _libraries :: [Text]
_libraries=[]
    , _dataFiles :: [([Char], [Char])]
_dataFiles=[]
    , _memoryDataFiles :: [([Char], [Char])]
_memoryDataFiles=[]
    , _tyPkgCtx :: Bool
_tyPkgCtx=Bool
False
    , _intWidth :: Int
_intWidth=ClashOpts -> Int
opt_intWidth ClashOpts
opts
    , _hdlsyn :: HdlSyn
_hdlsyn=ClashOpts -> HdlSyn
opt_hdlSyn ClashOpts
opts
    , _undefValue :: Maybe (Maybe Int)
_undefValue=ClashOpts -> Maybe (Maybe Int)
opt_forceUndefined ClashOpts
opts
    , _aggressiveXOptBB_ :: AggressiveXOptBB
_aggressiveXOptBB_=Bool -> AggressiveXOptBB
forall a b. Coercible a b => a -> b
coerce (ClashOpts -> Bool
opt_aggressiveXOptBB ClashOpts
opts)
    , _renderEnums_ :: RenderEnums
_renderEnums_=Bool -> RenderEnums
forall a b. Coercible a b => a -> b
coerce (ClashOpts -> Bool
opt_renderEnums ClashOpts
opts)
    , _domainConfigurations_ :: DomainMap
_domainConfigurations_=DomainMap
emptyDomainMap
    , _usages :: UsageMap
_usages=UsageMap
forall a. Monoid a => a
mempty
    }
  hdlKind :: SystemVerilogState -> HDL
hdlKind         = HDL -> SystemVerilogState -> HDL
forall a b. a -> b -> a
const HDL
SystemVerilog
  primDirs :: SystemVerilogState -> IO [[Char]]
primDirs        = IO [[Char]] -> SystemVerilogState -> IO [[Char]]
forall a b. a -> b -> a
const (IO [[Char]] -> SystemVerilogState -> IO [[Char]])
-> IO [[Char]] -> SystemVerilogState -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ do [Char]
root <- IO [Char]
primsRoot
                               [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [ [Char]
root [Char] -> [Char] -> [Char]
System.FilePath.</> [Char]
"common"
                                      , [Char]
root [Char] -> [Char] -> [Char]
System.FilePath.</> [Char]
"commonverilog"
                                      , [Char]
root [Char] -> [Char] -> [Char]
System.FilePath.</> [Char]
"systemverilog"
                                      ]
  extractTypes :: SystemVerilogState -> HashSet HWType
extractTypes    = SystemVerilogState -> HashSet HWType
_tyCache
  name :: SystemVerilogState -> [Char]
name            = [Char] -> SystemVerilogState -> [Char]
forall a b. a -> b -> a
const [Char]
"systemverilog"
  extension :: SystemVerilogState -> [Char]
extension       = [Char] -> SystemVerilogState -> [Char]
forall a b. a -> b -> a
const [Char]
".sv"

  genHDL :: ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State SystemVerilogState) (([Char], Doc), [([Char], Doc)])
genHDL          = ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State SystemVerilogState) (([Char], Doc), [([Char], Doc)])
genSystemVerilog
  mkTyPackage :: Text -> [HWType] -> Ap (State SystemVerilogState) [([Char], Doc)]
mkTyPackage     = Text -> [HWType] -> Ap (State SystemVerilogState) [([Char], Doc)]
mkTyPackage_
  hdlHWTypeKind :: HWType -> State SystemVerilogState HWKind
hdlHWTypeKind = \case
    Vector {} -> HWKind -> State SystemVerilogState HWKind
forall a. a -> StateT SystemVerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    RTree {} -> HWKind -> State SystemVerilogState HWKind
forall a. a -> StateT SystemVerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    Product {} -> HWKind -> State SystemVerilogState HWKind
forall a. a -> StateT SystemVerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    MemBlob {} -> HWKind -> State SystemVerilogState HWKind
forall a. a -> StateT SystemVerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
UserType
    BiDirectional PortDirection
_ HWType
ty -> HWType -> State SystemVerilogState HWKind
forall state. Backend state => HWType -> State state HWKind
hdlHWTypeKind HWType
ty
    Annotated [Attr Text]
_ HWType
ty -> HWType -> State SystemVerilogState HWKind
forall state. Backend state => HWType -> State state HWKind
hdlHWTypeKind HWType
ty
    HWType
_ -> HWKind -> State SystemVerilogState HWKind
forall a. a -> StateT SystemVerilogState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure HWKind
PrimitiveType
  hdlType :: Usage -> HWType -> SystemVerilogM Doc
hdlType Usage
_       = HWType -> SystemVerilogM Doc
verilogType
  hdlTypeErrValue :: HWType -> SystemVerilogM Doc
hdlTypeErrValue = HWType -> SystemVerilogM Doc
verilogTypeErrValue
  hdlTypeMark :: HWType -> SystemVerilogM Doc
hdlTypeMark     = HWType -> SystemVerilogM Doc
verilogTypeMark
  hdlRecSel :: HWType -> Int -> SystemVerilogM Doc
hdlRecSel       = HWType -> Int -> SystemVerilogM Doc
verilogRecSel
  hdlSig :: Text -> HWType -> SystemVerilogM Doc
hdlSig Text
t HWType
ty     = SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl (Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
t) HWType
ty
  genStmt :: Bool -> State SystemVerilogState Doc
genStmt Bool
True    = do Int
cnt <- Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
genDepth
                       (Int -> Identity Int)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState Int
genDepth ((Int -> Identity Int)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> Int -> State SystemVerilogState ()
forall s (m :: Type -> Type) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
                       if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                          then State SystemVerilogState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                          else State SystemVerilogState Doc
"generate"
  genStmt Bool
False   = do (Int -> Identity Int)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState Int
genDepth ((Int -> Identity Int)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> Int -> State SystemVerilogState ()
forall s (m :: Type -> Type) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= Int
1
                       Int
cnt <- Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
genDepth
                       if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                          then State SystemVerilogState Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
                          else State SystemVerilogState Doc
"endgenerate"
  inst :: Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
inst            = Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
inst_
  expr :: Bool -> Expr -> SystemVerilogM Doc
expr            = Bool -> Expr -> SystemVerilogM Doc
expr_
  iwWidth :: State SystemVerilogState Int
iwWidth         = Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  toBV :: HWType -> Text -> SystemVerilogM Doc
toBV HWType
hty Text
id_    = HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
hty (Identifier -> Maybe Modifier -> Expr
Identifier (HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake (Text -> Text
Text.toStrict Text
id_)) Maybe Modifier
forall a. Maybe a
Nothing)
  fromBV :: HWType -> Text -> SystemVerilogM Doc
fromBV HWType
hty Text
id_  = HWType -> Text -> SystemVerilogM Doc
simpleFromSLV HWType
hty (Text -> Text
Text.toStrict Text
id_)
  hdlSyn :: State SystemVerilogState HdlSyn
hdlSyn          = Getting HdlSyn SystemVerilogState HdlSyn
-> State SystemVerilogState HdlSyn
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting HdlSyn SystemVerilogState HdlSyn
Lens' SystemVerilogState HdlSyn
hdlsyn
  setModName :: Text -> SystemVerilogState -> SystemVerilogState
setModName Text
nm SystemVerilogState
s = SystemVerilogState
s {_modNm = nm}
  setTopName :: Identifier -> SystemVerilogState -> SystemVerilogState
setTopName Identifier
nm SystemVerilogState
s = SystemVerilogState
s {_topNm = nm}
  getTopName :: State SystemVerilogState Identifier
getTopName      = Getting Identifier SystemVerilogState Identifier
-> State SystemVerilogState Identifier
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Identifier SystemVerilogState Identifier
Lens' SystemVerilogState Identifier
topNm
  setSrcSpan :: SrcSpan -> State SystemVerilogState ()
setSrcSpan      = ((SrcSpan -> Identity SrcSpan)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState SrcSpan
srcSpan .=)
  getSrcSpan :: State SystemVerilogState SrcSpan
getSrcSpan      = Getting SrcSpan SystemVerilogState SrcSpan
-> State SystemVerilogState SrcSpan
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting SrcSpan SystemVerilogState SrcSpan
Lens' SystemVerilogState SrcSpan
srcSpan
  blockDecl :: Identifier -> [Declaration] -> SystemVerilogM Doc
blockDecl Identifier
_ [Declaration]
ds  = do
    Doc
decs <- [Declaration] -> SystemVerilogM Doc
decls [Declaration]
ds
    if Doc -> Bool
isEmpty Doc
decs
      then [Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds
      else
        Doc -> SystemVerilogM Doc
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
decs SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        [Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds
  addIncludes :: [([Char], Doc)] -> State SystemVerilogState ()
addIncludes [([Char], Doc)]
inc = ([([Char], Doc)] -> Identity [([Char], Doc)])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [([Char], Doc)]
includes (([([Char], Doc)] -> Identity [([Char], Doc)])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> ([([Char], Doc)] -> [([Char], Doc)])
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([([Char], Doc)]
inc++)
  addLibraries :: [Text] -> State SystemVerilogState ()
addLibraries [Text]
libs = ([Text] -> Identity [Text])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [Text]
libraries (([Text] -> Identity [Text])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> ([Text] -> [Text]) -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Text]
libs ++)
  addImports :: [Text] -> State SystemVerilogState ()
addImports [Text]
inps = ([Text] -> Identity [Text])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [Text]
imports (([Text] -> Identity [Text])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> ([Text] -> [Text]) -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Text]
inps ++)
  addAndSetData :: [Char] -> State SystemVerilogState [Char]
addAndSetData [Char]
f = do
    [([Char], [Char])]
fs <- Getting [([Char], [Char])] SystemVerilogState [([Char], [Char])]
-> State SystemVerilogState [([Char], [Char])]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], [Char])] SystemVerilogState [([Char], [Char])]
Lens' SystemVerilogState [([Char], [Char])]
dataFiles
    let ([([Char], [Char])]
fs',[Char]
f') = [([Char], [Char])] -> [Char] -> ([([Char], [Char])], [Char])
renderFilePath [([Char], [Char])]
fs [Char]
f
    ([([Char], [Char])] -> Identity [([Char], [Char])])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [([Char], [Char])]
dataFiles (([([Char], [Char])] -> Identity [([Char], [Char])])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> [([Char], [Char])] -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [([Char], [Char])]
fs'
    [Char] -> State SystemVerilogState [Char]
forall a. a -> StateT SystemVerilogState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
f'
  getDataFiles :: State SystemVerilogState [([Char], [Char])]
getDataFiles = Getting [([Char], [Char])] SystemVerilogState [([Char], [Char])]
-> State SystemVerilogState [([Char], [Char])]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], [Char])] SystemVerilogState [([Char], [Char])]
Lens' SystemVerilogState [([Char], [Char])]
dataFiles
  addMemoryDataFile :: ([Char], [Char]) -> State SystemVerilogState ()
addMemoryDataFile ([Char], [Char])
f = ([([Char], [Char])] -> Identity [([Char], [Char])])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [([Char], [Char])]
memoryDataFiles (([([Char], [Char])] -> Identity [([Char], [Char])])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> ([([Char], [Char])] -> [([Char], [Char])])
-> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (([Char], [Char])
f:)
  getMemoryDataFiles :: State SystemVerilogState [([Char], [Char])]
getMemoryDataFiles = Getting [([Char], [Char])] SystemVerilogState [([Char], [Char])]
-> State SystemVerilogState [([Char], [Char])]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], [Char])] SystemVerilogState [([Char], [Char])]
Lens' SystemVerilogState [([Char], [Char])]
memoryDataFiles
  ifThenElseExpr :: SystemVerilogState -> Bool
ifThenElseExpr SystemVerilogState
_ = Bool
True
  aggressiveXOptBB :: State SystemVerilogState AggressiveXOptBB
aggressiveXOptBB = Getting AggressiveXOptBB SystemVerilogState AggressiveXOptBB
-> State SystemVerilogState AggressiveXOptBB
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting AggressiveXOptBB SystemVerilogState AggressiveXOptBB
Lens' SystemVerilogState AggressiveXOptBB
aggressiveXOptBB_
  renderEnums :: State SystemVerilogState RenderEnums
renderEnums = Getting RenderEnums SystemVerilogState RenderEnums
-> State SystemVerilogState RenderEnums
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting RenderEnums SystemVerilogState RenderEnums
Lens' SystemVerilogState RenderEnums
renderEnums_
  domainConfigurations :: State SystemVerilogState DomainMap
domainConfigurations = Getting DomainMap SystemVerilogState DomainMap
-> State SystemVerilogState DomainMap
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting DomainMap SystemVerilogState DomainMap
Lens' SystemVerilogState DomainMap
domainConfigurations_
  setDomainConfigurations :: DomainMap -> SystemVerilogState -> SystemVerilogState
setDomainConfigurations DomainMap
confs SystemVerilogState
s = SystemVerilogState
s {_domainConfigurations_ = confs}

type SystemVerilogM a = Ap (State SystemVerilogState) a

-- | Generate SystemVerilog for a Netlist component
genSystemVerilog
  :: ClashOpts
  -> ModName
  -> SrcSpan
  -> IdentifierSet
  -> UsageMap
  -> Component
  -> SystemVerilogM ((String, Doc), [(String, Doc)])
genSystemVerilog :: ClashOpts
-> Text
-> SrcSpan
-> IdentifierSet
-> UsageMap
-> Component
-> Ap (State SystemVerilogState) (([Char], Doc), [([Char], Doc)])
genSystemVerilog ClashOpts
opts Text
_ SrcSpan
sp IdentifierSet
seen UsageMap
us Component
c = do
    -- Don't have type names conflict with module names or with previously
    -- generated type names.
    --
    -- TODO: Collect all type names up front, to prevent relatively costly union.
    -- TODO: Investigate whether type names / signal names collide in the first place
    State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState () -> Ap (State SystemVerilogState) ())
-> State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall a b. (a -> b) -> a -> b
$ do
      (IdentifierSet -> Identity IdentifierSet)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState IdentifierSet
idSeen ((IdentifierSet -> Identity IdentifierSet)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (IdentifierSet -> IdentifierSet) -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HasCallStack => IdentifierSet -> IdentifierSet -> IdentifierSet
IdentifierSet -> IdentifierSet -> IdentifierSet
Id.union IdentifierSet
seen
      (UsageMap -> Identity UsageMap)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState UsageMap
usages ((UsageMap -> Identity UsageMap)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> UsageMap -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UsageMap
us
      SrcSpan -> State SystemVerilogState ()
forall state. Backend state => SrcSpan -> State state ()
setSrcSpan SrcSpan
sp

    Doc
v    <- SystemVerilogM Doc
verilog
    [([Char], Doc)]
incs <- State SystemVerilogState [([Char], Doc)]
-> Ap (State SystemVerilogState) [([Char], Doc)]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState [([Char], Doc)]
 -> Ap (State SystemVerilogState) [([Char], Doc)])
-> State SystemVerilogState [([Char], Doc)]
-> Ap (State SystemVerilogState) [([Char], Doc)]
forall a b. (a -> b) -> a -> b
$ Getting [([Char], Doc)] SystemVerilogState [([Char], Doc)]
-> State SystemVerilogState [([Char], Doc)]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [([Char], Doc)] SystemVerilogState [([Char], Doc)]
Lens' SystemVerilogState [([Char], Doc)]
includes
    (([Char], Doc), [([Char], Doc)])
-> Ap (State SystemVerilogState) (([Char], Doc), [([Char], Doc)])
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((Text -> [Char]
TextS.unpack (Identifier -> Text
Id.toText Identifier
cName), Doc
v), [([Char], Doc)]
incs)
  where
    cName :: Identifier
cName   = Component -> Identifier
componentName Component
c
    verilog :: SystemVerilogM Doc
verilog = SystemVerilogM Doc
commentHeader SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              SystemVerilogM Doc
nettype SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              SystemVerilogM Doc
timescale SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              Component -> SystemVerilogM Doc
module_ Component
c
    commentHeader :: SystemVerilogM Doc
commentHeader
         = SystemVerilogM Doc
"/* AUTOMATICALLY GENERATED SYSTEMVERILOG-2005 SOURCE CODE."
      SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"** GENERATED BY CLASH " SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string ([Char] -> Text
Text.pack [Char]
clashVer) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
". DO NOT MODIFY."
      SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"*/"
    nettype :: SystemVerilogM Doc
nettype = SystemVerilogM Doc
"`default_nettype none"
    timescale :: SystemVerilogM Doc
timescale = SystemVerilogM Doc
"`timescale 100fs/" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string ([Char] -> Text
Text.pack [Char]
precision)
    precision :: [Char]
precision = Period -> [Char]
periodToString (ClashOpts -> Period
opt_timescalePrecision ClashOpts
opts)

-- | Generate a SystemVerilog package containing type definitions for the given HWTypes
mkTyPackage_ :: TextS.Text -> [HWType] -> SystemVerilogM [(String,Doc)]
mkTyPackage_ :: Text -> [HWType] -> Ap (State SystemVerilogState) [([Char], Doc)]
mkTyPackage_ Text
modName [HWType]
hwtys = do
    State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((Bool -> Identity Bool)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState Bool
tyPkgCtx ((Bool -> Identity Bool)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> Bool -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True)
    [HWType]
normTys <- [HWType] -> [HWType]
forall a. Eq a => [a] -> [a]
nub ([HWType] -> [HWType])
-> Ap (State SystemVerilogState) [HWType]
-> Ap (State SystemVerilogState) [HWType]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (HWType -> Ap (State SystemVerilogState) HWType)
-> [HWType] -> Ap (State SystemVerilogState) [HWType]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HWType -> Ap (State SystemVerilogState) HWType
normaliseType) ([HWType]
hwtys [HWType] -> [HWType] -> [HWType]
forall a. [a] -> [a] -> [a]
++ [HWType]
usedTys)
    let
      needsDec :: [HWType]
needsDec    = (HWType -> HWType -> Bool) -> [HWType] -> [HWType]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy HWType -> HWType -> Bool
eqReprTy ([HWType] -> [HWType]) -> [HWType] -> [HWType]
forall a b. (a -> b) -> a -> b
$ [HWType]
normTys
      hwTysSorted :: [HWType]
hwTysSorted = [HWType] -> [HWType]
topSortHWTys [HWType]
needsDec
      packageDec :: SystemVerilogM Doc
packageDec  = Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ ([Maybe Doc] -> [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes (Ap (State SystemVerilogState) [Maybe Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ (HWType -> Ap (State SystemVerilogState) (Maybe Doc))
-> [HWType] -> Ap (State SystemVerilogState) [Maybe Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM HWType -> Ap (State SystemVerilogState) (Maybe Doc)
tyDec [HWType]
hwTysSorted
      funDecs :: SystemVerilogM Doc
funDecs     = Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ ([Maybe Doc] -> [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes (Ap (State SystemVerilogState) [Maybe Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ (HWType -> Ap (State SystemVerilogState) (Maybe Doc))
-> [HWType] -> Ap (State SystemVerilogState) [Maybe Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM HWType -> Ap (State SystemVerilogState) (Maybe Doc)
funDec [HWType]
hwTysSorted

    [([Char], Doc)]
pkg <- (([Char], Doc) -> [([Char], Doc)] -> [([Char], Doc)]
forall a. a -> [a] -> [a]
:[]) (([Char], Doc) -> [([Char], Doc)])
-> (Doc -> ([Char], Doc)) -> Doc -> [([Char], Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Text -> [Char]
TextS.unpack Text
modName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_types",) (Doc -> [([Char], Doc)])
-> SystemVerilogM Doc
-> Ap (State SystemVerilogState) [([Char], Doc)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$>
       SystemVerilogM Doc
"package" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
modNameD SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
         Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 SystemVerilogM Doc
packageDec SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
         Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 SystemVerilogM Doc
funDecs SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
       SystemVerilogM Doc
"endpackage" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
modNameD SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types"
    State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((Bool -> Identity Bool)
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState Bool
tyPkgCtx ((Bool -> Identity Bool)
 -> SystemVerilogState -> Identity SystemVerilogState)
-> Bool -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False)
    [([Char], Doc)] -> Ap (State SystemVerilogState) [([Char], Doc)]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [([Char], Doc)]
pkg
  where
    modNameD :: SystemVerilogM Doc
modNameD    = Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
modName
    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

    eqReprTy :: HWType -> HWType -> Bool
    eqReprTy :: HWType -> HWType -> Bool
eqReprTy (Vector Int
n HWType
ty1) (Vector Int
m HWType
ty2)
      | Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n    = HWType -> HWType -> Bool
eqReprTy HWType
ty1 HWType
ty2
      | Bool
otherwise = Bool
False
    eqReprTy (RTree Int
n HWType
ty1) (RTree Int
m HWType
ty2)
      | Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n    = HWType -> HWType -> Bool
eqReprTy HWType
ty1 HWType
ty2
      | Bool
otherwise = Bool
False
    eqReprTy HWType
Bit  HWType
ty2 = HWType
ty2 HWType -> [HWType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [HWType
Bit,HWType
Bool]
    eqReprTy HWType
Bool HWType
ty2 = HWType
ty2 HWType -> [HWType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [HWType
Bit,HWType
Bool]
    eqReprTy HWType
ty1 HWType
ty2
      | HWType -> Bool
isUnsigned HWType
ty1 Bool -> Bool -> Bool
&& HWType -> Bool
isUnsigned HWType
ty2 = HWType -> Int
typeSize HWType
ty1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== HWType -> Int
typeSize HWType
ty2
      | Bool
otherwise                        = HWType
ty1 HWType -> HWType -> Bool
forall a. Eq a => a -> a -> Bool
== HWType
ty2

    isUnsigned :: HWType -> Bool
    isUnsigned :: HWType -> Bool
isUnsigned (Unsigned Int
_)        = Bool
True
    isUnsigned (BitVector Int
_)       = Bool
True
    isUnsigned (Index Integer
_)           = Bool
True
    isUnsigned (Sum Text
_ [Text]
_)           = Bool
True
    isUnsigned (CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_) = Bool
True
    isUnsigned (SP Text
_ [(Text, [HWType])]
_)            = Bool
True
    isUnsigned (CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_)  = Bool
True
    isUnsigned HWType
_                   = Bool
False

mkUsedTys :: HWType
        -> [HWType]
mkUsedTys :: HWType -> [HWType]
mkUsedTys v :: HWType
v@(Vector Int
_ HWType
elTy)     = HWType
v HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: HWType -> [HWType]
mkUsedTys HWType
elTy
mkUsedTys t :: HWType
t@(RTree Int
_ HWType
elTy)      = HWType
t HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: HWType -> [HWType]
mkUsedTys HWType
elTy
mkUsedTys p :: HWType
p@(Product Text
_ Maybe [Text]
_ [HWType]
elTys) = HWType
p HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys [HWType]
elTys
mkUsedTys sp :: HWType
sp@(SP Text
_ [(Text, [HWType])]
elTys)       = HWType
sp HWType -> [HWType] -> [HWType]
forall a. a -> [a] -> [a]
: (HWType -> [HWType]) -> [HWType] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [HWType]
mkUsedTys (((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Text, [HWType])]
elTys)
mkUsedTys HWType
t                     = [HWType
t]

topSortHWTys :: [HWType]
             -> [HWType]
topSortHWTys :: [HWType] -> [HWType]
topSortHWTys [HWType]
hwtys = [HWType]
sorted
  where
    nodes :: [(Unique, HWType)]
nodes  = [Unique] -> [HWType] -> [(Unique, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Unique
0..] [HWType]
hwtys
    nodesI :: HashMap HWType Unique
nodesI = [(HWType, Unique)] -> HashMap HWType Unique
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([HWType] -> [Unique] -> [(HWType, Unique)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HWType]
hwtys [Unique
0..])
    edges :: [(Unique, Unique)]
edges  = (HWType -> [(Unique, Unique)]) -> [HWType] -> [(Unique, Unique)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap HWType -> [(Unique, Unique)]
edge [HWType]
hwtys
    sorted :: [HWType]
sorted =
      case [(Unique, HWType)] -> [(Unique, Unique)] -> Either [Char] [HWType]
forall a. [(Unique, a)] -> [(Unique, Unique)] -> Either [Char] [a]
reverseTopSort [(Unique, HWType)]
nodes [(Unique, Unique)]
edges of
        Left [Char]
err -> [Char] -> [HWType]
forall a. HasCallStack => [Char] -> a
error ([Char]
"[BUG IN CLASH] topSortHWTys: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err)
        Right [HWType]
ns -> [HWType]
ns

    edge :: HWType -> [(Unique, Unique)]
edge t :: HWType
t@(Vector Int
_ HWType
elTy) = [(Unique, Unique)]
-> (Unique -> [(Unique, Unique)])
-> Maybe Unique
-> [(Unique, Unique)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((Unique, Unique) -> [(Unique, Unique)] -> [(Unique, Unique)]
forall a. a -> [a] -> [a]
:[]) ((Unique, Unique) -> [(Unique, Unique)])
-> (Unique -> (Unique, Unique)) -> Unique -> [(Unique, Unique)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unique -> HWType -> HashMap HWType Unique -> Unique
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault ([Char] -> Unique
forall a. HasCallStack => [Char] -> a
error ([Char] -> Unique) -> [Char] -> Unique
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Vector") HWType
t HashMap HWType Unique
nodesI,))
                                      (HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
elTy HashMap HWType Unique
nodesI)
    edge t :: HWType
t@(RTree Int
_ HWType
elTy)  = [(Unique, Unique)]
-> (Unique -> [(Unique, Unique)])
-> Maybe Unique
-> [(Unique, Unique)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((Unique, Unique) -> [(Unique, Unique)] -> [(Unique, Unique)]
forall a. a -> [a] -> [a]
:[]) ((Unique, Unique) -> [(Unique, Unique)])
-> (Unique -> (Unique, Unique)) -> Unique -> [(Unique, Unique)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unique -> HWType -> HashMap HWType Unique -> Unique
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault ([Char] -> Unique
forall a. HasCallStack => [Char] -> a
error ([Char] -> Unique) -> [Char] -> Unique
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"RTree") HWType
t HashMap HWType Unique
nodesI,))
                                      (HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
elTy HashMap HWType Unique
nodesI)
    edge t :: HWType
t@(Product Text
_ Maybe [Text]
_ [HWType]
tys) = let ti :: Unique
ti = Unique -> HWType -> HashMap HWType Unique -> Unique
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault ([Char] -> Unique
forall a. HasCallStack => [Char] -> a
error ([Char] -> Unique) -> [Char] -> Unique
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Product") HWType
t HashMap HWType Unique
nodesI
                               in (HWType -> Maybe (Unique, Unique))
-> [HWType] -> [(Unique, Unique)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\HWType
ty -> (Unique -> (Unique, Unique))
-> Maybe Unique -> Maybe (Unique, Unique)
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (Unique
ti,) (HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
ty HashMap HWType Unique
nodesI)) [HWType]
tys
    edge t :: HWType
t@(SP Text
_ [(Text, [HWType])]
ctys)     = let ti :: Unique
ti = Unique -> HWType -> HashMap HWType Unique -> Unique
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault ([Char] -> Unique
forall a. HasCallStack => [Char] -> a
error ([Char] -> Unique) -> [Char] -> Unique
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"SP") HWType
t HashMap HWType Unique
nodesI
                             in ((Text, [HWType]) -> [(Unique, Unique)])
-> [(Text, [HWType])] -> [(Unique, Unique)]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(Text
_,[HWType]
tys) -> (HWType -> Maybe (Unique, Unique))
-> [HWType] -> [(Unique, Unique)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\HWType
ty -> (Unique -> (Unique, Unique))
-> Maybe Unique -> Maybe (Unique, Unique)
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (Unique
ti,) (HWType -> HashMap HWType Unique -> Maybe Unique
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HWType
ty HashMap HWType Unique
nodesI)) [HWType]
tys) [(Text, [HWType])]
ctys
    edge HWType
_                 = []

normaliseType :: HWType -> SystemVerilogM HWType
normaliseType :: HWType -> Ap (State SystemVerilogState) HWType
normaliseType (Annotated [Attr Text]
_ HWType
ty) = HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
ty
normaliseType (Vector Int
n HWType
ty)    = Int -> HWType -> HWType
Vector Int
n (HWType -> HWType)
-> Ap (State SystemVerilogState) HWType
-> Ap (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
ty)
normaliseType (MemBlob Int
n Int
m)    = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m))
normaliseType (RTree Int
d HWType
ty)     = Int -> HWType -> HWType
RTree Int
d (HWType -> HWType)
-> Ap (State SystemVerilogState) HWType
-> Ap (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
ty)
normaliseType (Product Text
nm Maybe [Text]
lbls [HWType]
tys) = Text -> Maybe [Text] -> [HWType] -> HWType
Product Text
nm Maybe [Text]
lbls ([HWType] -> HWType)
-> Ap (State SystemVerilogState) [HWType]
-> Ap (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HWType -> Ap (State SystemVerilogState) HWType)
-> [HWType] -> Ap (State SystemVerilogState) [HWType]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM HWType -> Ap (State SystemVerilogState) HWType
normaliseType [HWType]
tys)
normaliseType ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
elTys)      = do
  State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState () -> Ap (State SystemVerilogState) ())
-> State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall a b. (a -> b) -> a -> b
$ (HWType -> State SystemVerilogState ())
-> [HWType] -> State SystemVerilogState ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache %=) ((HashSet HWType -> HashSet HWType) -> State SystemVerilogState ())
-> (HWType -> HashSet HWType -> HashSet HWType)
-> HWType
-> State SystemVerilogState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> HashSet HWType -> HashSet HWType
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert) (((Text, [HWType]) -> [HWType]) -> [(Text, [HWType])] -> [HWType]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd [(Text, [HWType])]
elTys)
  HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
ty))
normaliseType (CustomSP Text
_ DataRepr'
_dataRepr Int
size [(ConstrRepr', Text, [HWType])]
elTys) = do
  State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState () -> Ap (State SystemVerilogState) ())
-> State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall a b. (a -> b) -> a -> b
$ (HWType -> State SystemVerilogState ())
-> [HWType] -> State SystemVerilogState ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache %=) ((HashSet HWType -> HashSet HWType) -> State SystemVerilogState ())
-> (HWType -> HashSet HWType -> HashSet HWType)
-> HWType
-> State SystemVerilogState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> HashSet HWType -> HashSet HWType
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert) [HWType
ty | (ConstrRepr'
_, Text
_, [HWType]
subTys) <- [(ConstrRepr', Text, [HWType])]
elTys, HWType
ty <- [HWType]
subTys]
  HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector Int
size)
normaliseType ty :: HWType
ty@(Index Integer
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
Unsigned (HWType -> Int
typeSize HWType
ty))
normaliseType ty :: HWType
ty@(Sum Text
_ [Text]
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
ty))
normaliseType ty :: HWType
ty@(CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> HWType
BitVector (HWType -> Int
typeSize HWType
ty))
normaliseType (Clock Text
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (ClockN Text
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (Reset Text
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bit
normaliseType (Enable Text
_) = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
Bool
normaliseType (BiDirectional PortDirection
dir HWType
ty) = PortDirection -> HWType -> HWType
BiDirectional PortDirection
dir (HWType -> HWType)
-> Ap (State SystemVerilogState) HWType
-> Ap (State SystemVerilogState) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
ty
normaliseType HWType
ty = HWType -> Ap (State SystemVerilogState) HWType
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return HWType
ty


range :: Either Int Int -> SystemVerilogM Doc
range :: Either Int Int -> SystemVerilogM Doc
range (Left Int
n)  = SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
range (Right Int
n) = SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

tyDec :: HWType -> SystemVerilogM (Maybe Doc)
tyDec :: HWType -> Ap (State SystemVerilogState) (Maybe Doc)
tyDec ty :: HWType
ty@(Vector Int
n HWType
elTy) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> do
  HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
      Just ([Right Int
n',Left Int
n''],SystemVerilogM Doc
elTy') ->
        SystemVerilogM Doc
"typedef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n''Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
        HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      Maybe ([Either Int Int], SystemVerilogM Doc)
_ ->
        SystemVerilogM Doc
"typedef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
        HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
    HdlSyn
_ -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
      Just (Right Int
n':[Either Int Int]
ns,SystemVerilogM Doc
elTy') ->
        SystemVerilogM Doc
"typedef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> SystemVerilogM Doc)
-> [Either Int Int] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Either Int Int -> SystemVerilogM Doc
range [Either Int Int]
ns) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
        SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      Maybe ([Either Int Int], SystemVerilogM Doc)
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"
tyDec ty :: HWType
ty@(RTree Int
n HWType
elTy) | HWType -> Int
typeSize HWType
elTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> do
  HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
      Just ([Right Int
n',Left Int
n''],SystemVerilogM Doc
elTy') -> -- n' == 2^n
        SystemVerilogM Doc
"typedef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n''Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
        HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      Maybe ([Either Int Int], SystemVerilogM Doc)
_ ->
        SystemVerilogM Doc
"typedef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
        HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
    HdlSyn
_ -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
      Just (Right Int
n':[Either Int Int]
ns,SystemVerilogM Doc
elTy') -> -- n' == 2^n
        SystemVerilogM Doc
"typedef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> SystemVerilogM Doc)
-> [Either Int Int] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Either Int Int -> SystemVerilogM Doc
range [Either Int Int]
ns) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
        SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
      Maybe ([Either Int Int], SystemVerilogM Doc)
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"
tyDec ty :: HWType
ty@(Product Text
_ Maybe [Text]
_ [HWType]
tys) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> SystemVerilogM Doc
prodDec
  where
    prodDec :: SystemVerilogM Doc
prodDec = SystemVerilogM Doc
"typedef struct packed {" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ ([Maybe Doc] -> [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes (Ap (State SystemVerilogState) [Maybe Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ (SystemVerilogM Doc
 -> HWType -> Ap (State SystemVerilogState) (Maybe Doc))
-> [SystemVerilogM Doc]
-> [HWType]
-> Ap (State SystemVerilogState) [Maybe Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM SystemVerilogM Doc
-> HWType -> Ap (State SystemVerilogState) (Maybe Doc)
combineM [SystemVerilogM Doc]
selNames [HWType]
tys) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              SystemVerilogM Doc
"}" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

    combineM :: SystemVerilogM Doc
-> HWType -> Ap (State SystemVerilogState) (Maybe Doc)
combineM SystemVerilogM Doc
x HWType
y = do
      Maybe Doc
yM <- HWType -> Ap (State SystemVerilogState) (Maybe Doc)
lvType HWType
y
      case Maybe Doc
yM of
        Maybe Doc
Nothing -> Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Doc
forall a. Maybe a
Nothing
        Just Doc
y' -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Doc -> SystemVerilogM Doc
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
y' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
x SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
    tName :: SystemVerilogM Doc
tName    = HWType -> SystemVerilogM Doc
tyName HWType
ty
    selNames :: [SystemVerilogM Doc]
selNames = (Int -> SystemVerilogM Doc) -> [Int] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_sel" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i) [Int
0..]

tyDec HWType
_ = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Doc
forall a. Maybe a
Nothing

splitVecTy :: HWType -> Maybe ([Either Int Int],SystemVerilogM Doc)
splitVecTy :: HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy = (([Either Int Int], HWType)
 -> ([Either Int Int], SystemVerilogM Doc))
-> Maybe ([Either Int Int], HWType)
-> Maybe ([Either Int Int], SystemVerilogM Doc)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either Int Int], HWType)
-> ([Either Int Int], SystemVerilogM Doc)
forall {b}.
([Either Int b], HWType) -> ([Either Int b], SystemVerilogM Doc)
splitElemTy (Maybe ([Either Int Int], HWType)
 -> Maybe ([Either Int Int], SystemVerilogM Doc))
-> (HWType -> Maybe ([Either Int Int], HWType))
-> HWType
-> Maybe ([Either Int Int], SystemVerilogM Doc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Maybe ([Either Int Int], HWType)
forall {a}. HWType -> Maybe ([Either a Int], HWType)
go
  where
    splitElemTy :: ([Either Int b], HWType) -> ([Either Int b], SystemVerilogM Doc)
splitElemTy ([Either Int b]
ns,HWType
t) = case HWType
t of
      Product {} -> ([Either Int b]
ns, HWType -> SystemVerilogM Doc
verilogType HWType
t)
      Vector {}  -> [Char] -> ([Either Int b], SystemVerilogM Doc)
forall a. HasCallStack => [Char] -> a
error ([Char] -> ([Either Int b], SystemVerilogM Doc))
-> [Char] -> ([Either Int b], SystemVerilogM Doc)
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"
      Clock {}   -> ([Either Int b]
ns, HWType -> SystemVerilogM Doc
verilogType HWType
t)
      ClockN {}  -> ([Either Int b]
ns, HWType -> SystemVerilogM Doc
verilogType HWType
t)
      Reset {}   -> ([Either Int b]
ns, SystemVerilogM Doc
"logic")
      Enable {}  -> ([Either Int b]
ns, SystemVerilogM Doc
"logic")
      HWType
Bool       -> ([Either Int b]
ns, SystemVerilogM Doc
"logic")
      HWType
Bit        -> ([Either Int b]
ns, SystemVerilogM Doc
"logic")
      HWType
String     -> ([Either Int b]
ns, SystemVerilogM Doc
"string")
      Signed Int
n   -> ([Either Int b]
ns [Either Int b] -> [Either Int b] -> [Either Int b]
forall a. [a] -> [a] -> [a]
++ [Int -> Either Int b
forall a b. a -> Either a b
Left Int
n],SystemVerilogM Doc
"logic signed")
      HWType
_          -> ([Either Int b]
ns [Either Int b] -> [Either Int b] -> [Either Int b]
forall a. [a] -> [a] -> [a]
++ [Int -> Either Int b
forall a b. a -> Either a b
Left (HWType -> Int
typeSize HWType
t)], SystemVerilogM Doc
"logic")

    go :: HWType -> Maybe ([Either a Int], HWType)
go (Vector Int
n HWType
elTy) = case HWType -> Maybe ([Either a Int], HWType)
go HWType
elTy of
      Just ([Either a Int]
ns,HWType
elTy') -> ([Either a Int], HWType) -> Maybe ([Either a Int], HWType)
forall a. a -> Maybe a
Just (Int -> Either a Int
forall a b. b -> Either a b
Right Int
nEither a Int -> [Either a Int] -> [Either a Int]
forall a. a -> [a] -> [a]
:[Either a Int]
ns,HWType
elTy')
      Maybe ([Either a Int], HWType)
_               -> ([Either a Int], HWType) -> Maybe ([Either a Int], HWType)
forall a. a -> Maybe a
Just ([Int -> Either a Int
forall a b. b -> Either a b
Right Int
n],HWType
elTy)

    go (RTree Int
n HWType
elTy) = let n' :: Int
n' = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n in case HWType -> Maybe ([Either a Int], HWType)
go HWType
elTy of
      Just ([Either a Int]
ns,HWType
elTy') -> ([Either a Int], HWType) -> Maybe ([Either a Int], HWType)
forall a. a -> Maybe a
Just (Int -> Either a Int
forall a b. b -> Either a b
Right Int
n'Either a Int -> [Either a Int] -> [Either a Int]
forall a. a -> [a] -> [a]
:[Either a Int]
ns,HWType
elTy')
      Maybe ([Either a Int], HWType)
_               -> ([Either a Int], HWType) -> Maybe ([Either a Int], HWType)
forall a. a -> Maybe a
Just ([Int -> Either a Int
forall a b. b -> Either a b
Right Int
n'],HWType
elTy)

    go HWType
_ = Maybe ([Either a Int], HWType)
forall a. Maybe a
Nothing

lvType :: HWType -> SystemVerilogM (Maybe Doc)
lvType :: HWType -> Ap (State SystemVerilogState) (Maybe Doc)
lvType ty :: HWType
ty@(Vector Int
n HWType
elTy) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> do
  HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
    HdlSyn
_ -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
      Just ([Either Int Int]
ns,SystemVerilogM Doc
elTy') -> SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> SystemVerilogM Doc)
-> [Either Int Int] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Either Int Int -> SystemVerilogM Doc
range [Either Int Int]
ns)
      Maybe ([Either Int Int], SystemVerilogM Doc)
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"
lvType ty :: HWType
ty@(RTree Int
n HWType
elTy) | HWType -> Int
typeSize HWType
elTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> do
  HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
    HdlSyn
_ -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
      Just ([Either Int Int]
ns,SystemVerilogM Doc
elTy') -> SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> SystemVerilogM Doc)
-> [Either Int Int] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Either Int Int -> SystemVerilogM Doc
range [Either Int Int]
ns)
      Maybe ([Either Int Int], SystemVerilogM Doc)
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"
lvType HWType
ty | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> HWType -> SystemVerilogM Doc
verilogType HWType
ty
lvType HWType
_ = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Doc
forall a. Maybe a
Nothing

funDec :: HWType -> SystemVerilogM (Maybe Doc)
funDec :: HWType -> Ap (State SystemVerilogState) (Maybe Doc)
funDec ty :: HWType
ty@(Vector Int
n HWType
elTy) | HWType -> Int
typeSize HWType
ty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$>
  SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
ranges SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl SystemVerilogM Doc
"i" HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
    (SystemVerilogM Doc
"for" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc
"int n = 0" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n <" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n=n+1") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets SystemVerilogM Doc
"n" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"i[n]" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"endfunction" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
ranges SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"i") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
    (SystemVerilogM Doc
"for" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc
"int n = 0" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n <" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n=n+1") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets SystemVerilogM Doc
"n" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"i[n]" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"endfunction" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then
    SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_cons" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl SystemVerilogM Doc
"x" HWType
elTy SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
vecSigDecl SystemVerilogM Doc
"xs") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
      (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_cons" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
elTy (Identifier -> Maybe Modifier -> Expr
Identifier (HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake Text
"x") Maybe Modifier
forall a. Maybe a
Nothing)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
       SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_cons" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"xs" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    SystemVerilogM Doc
"endfunction"
  else
    SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_cons" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl SystemVerilogM Doc
"x" HWType
elTy) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
      (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_cons" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> (HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
elTy (Identifier -> Maybe Modifier -> Expr
Identifier (HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake Text
"x") Maybe Modifier
forall a. Maybe a
Nothing)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    SystemVerilogM Doc
"endfunction"
  where
    tName :: SystemVerilogM Doc
tName  = HWType -> SystemVerilogM Doc
tyName HWType
ty
    ranges :: SystemVerilogM Doc
ranges = SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
             SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

    vecSigDecl :: SystemVerilogM Doc -> SystemVerilogM Doc
    vecSigDecl :: SystemVerilogM Doc -> SystemVerilogM Doc
vecSigDecl SystemVerilogM Doc
d = do
      HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
      case HdlSyn
syn of
        HdlSyn
Vivado -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
          Just ([Right Int
n',Left Int
n''],SystemVerilogM Doc
elTy') ->
            SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n''Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
            SystemVerilogM Doc
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
          Maybe ([Either Int Int], SystemVerilogM Doc)
_ ->
            SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
            SystemVerilogM Doc
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
        HdlSyn
_ -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy HWType
ty of
         Just (Right Int
n':[Either Int Int]
ns,SystemVerilogM Doc
elTy') ->
           SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> SystemVerilogM Doc)
-> [Either Int Int] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Either Int Int -> SystemVerilogM Doc
range [Either Int Int]
ns) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
           SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2))
         Maybe ([Either Int Int], SystemVerilogM Doc)
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"


funDec ty :: HWType
ty@(RTree Int
n HWType
elTy) | HWType -> Int
typeSize HWType
elTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$>
  SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
ranges SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl SystemVerilogM Doc
"i" HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
    (SystemVerilogM Doc
"for" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc
"int n = 0" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n <" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n=n+1") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets SystemVerilogM Doc
"n" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"i[n]" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"endfunction" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
ranges SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"i") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
    (SystemVerilogM Doc
"for" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc
"int n = 0" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n <" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"n=n+1") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets SystemVerilogM Doc
"n" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"i[n]" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"endfunction" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then
        SystemVerilogM Doc
"function" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"automatic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_br" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (SystemVerilogM Doc -> SystemVerilogM Doc
treeSigDecl SystemVerilogM Doc
"l" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
treeSigDecl SystemVerilogM Doc
"r") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2
          (SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_br" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"l" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
           SystemVerilogM Doc
tName SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_br" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"r" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        SystemVerilogM Doc
"endfunction"
      else
        SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc)
  where
    treeSigDecl :: SystemVerilogM Doc -> SystemVerilogM Doc
    treeSigDecl :: SystemVerilogM Doc -> SystemVerilogM Doc
treeSigDecl SystemVerilogM Doc
d = do
      HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
      case HdlSyn
syn of
        HdlSyn
Vivado -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy (Int -> HWType -> HWType
RTree (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
elTy) of
          Just ([Right Int
n',Left Int
n''],SystemVerilogM Doc
elTy') -> -- n' == 2 ^ (n-1)
            SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n''Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
            SystemVerilogM Doc
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
          Maybe ([Either Int Int], SystemVerilogM Doc)
_ ->
            SystemVerilogM Doc
"logic" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
            SystemVerilogM Doc
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
        HdlSyn
_ -> case HWType -> Maybe ([Either Int Int], SystemVerilogM Doc)
splitVecTy (Int -> HWType -> HWType
RTree (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
elTy) of
          Just (Right Int
n':[Either Int Int]
ns,SystemVerilogM Doc
elTy') -> -- n' == 2 ^ (n-1)
            SystemVerilogM Doc
elTy' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either Int Int -> SystemVerilogM Doc)
-> [Either Int Int] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Either Int Int -> SystemVerilogM Doc
range [Either Int Int]
ns) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
            SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
          Maybe ([Either Int Int], SystemVerilogM Doc)
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"impossible"

    tName :: SystemVerilogM Doc
tName  = HWType -> SystemVerilogM Doc
tyName HWType
ty
    ranges :: SystemVerilogM Doc
ranges = SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
             SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

funDec HWType
_ = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Doc
forall a. Maybe a
Nothing

module_ :: Component -> SystemVerilogM Doc
module_ :: Component -> SystemVerilogM Doc
module_ Component
c =
  SystemVerilogM Doc
modVerilog SystemVerilogM Doc
-> Ap (State SystemVerilogState) () -> SystemVerilogM Doc
forall a b.
Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
-> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (([Text] -> Identity [Text])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [Text]
imports (([Text] -> Identity [Text])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> [Text] -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [] State SystemVerilogState ()
-> State SystemVerilogState () -> State SystemVerilogState ()
forall a b.
State SystemVerilogState a
-> State SystemVerilogState b -> State SystemVerilogState b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ([Identifier] -> Identity [Identifier])
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState [Identifier]
oports (([Identifier] -> Identity [Identifier])
 -> SystemVerilogState -> Identity SystemVerilogState)
-> [Identifier] -> State SystemVerilogState ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [])
 where
  modVerilog :: SystemVerilogM Doc
modVerilog = do
    Doc
body <- SystemVerilogM Doc
modBody
    [Text]
imps <- State SystemVerilogState [Text]
-> Ap (State SystemVerilogState) [Text]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState [Text]
 -> Ap (State SystemVerilogState) [Text])
-> State SystemVerilogState [Text]
-> Ap (State SystemVerilogState) [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] SystemVerilogState [Text]
-> State SystemVerilogState [Text]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Text] SystemVerilogState [Text]
Lens' SystemVerilogState [Text]
imports
    [Text]
libs <- State SystemVerilogState [Text]
-> Ap (State SystemVerilogState) [Text]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState [Text]
 -> Ap (State SystemVerilogState) [Text])
-> State SystemVerilogState [Text]
-> Ap (State SystemVerilogState) [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] SystemVerilogState [Text]
-> State SystemVerilogState [Text]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Text] SystemVerilogState [Text]
Lens' SystemVerilogState [Text]
libraries
    SystemVerilogM Doc
modHeader SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
modPorts SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Text] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => [Text] -> Ap m Doc
include ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
imps) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Text] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => [Text] -> Ap m Doc
uselibs ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
libs) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> SystemVerilogM Doc
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
body SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
modEnding

  modHeader :: SystemVerilogM Doc
modHeader  = SystemVerilogM Doc
"module" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty (Component -> Identifier
componentName Component
c)
  modPorts :: SystemVerilogM Doc
modPorts   = Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
4 (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall {m :: Type -> Type}.
(Monad m, Semigroup (m Doc)) =>
m [Doc] -> m Doc
tupleInputs Ap (State SystemVerilogState) [Doc]
inPorts SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall {m :: Type -> Type}.
(Monad m, Semigroup (m Doc)) =>
m [Doc] -> m Doc
tupleOutputs Ap (State SystemVerilogState) [Doc]
outPorts SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
  modBody :: SystemVerilogM Doc
modBody    = Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Declaration] -> SystemVerilogM Doc
decls (Component -> [Declaration]
declarations Component
c)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Declaration] -> SystemVerilogM Doc
insts (Component -> [Declaration]
declarations Component
c))
  modEnding :: SystemVerilogM Doc
modEnding  = SystemVerilogM Doc
"endmodule"

  inPorts :: Ap (State SystemVerilogState) [Doc]
inPorts  = [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ (Maybe Any, Bool)
-> (Identifier, HWType) -> Maybe Expr -> SystemVerilogM Doc
forall {a} {a}.
Pretty a =>
(Maybe a, Bool) -> (a, HWType) -> Maybe Expr -> SystemVerilogM Doc
sigPort (Maybe Any
forall a. Maybe a
Nothing,HWType -> Bool
isBiSignalIn HWType
ty) (Identifier
i,HWType
ty) Maybe Expr
forall a. Maybe a
Nothing | (Identifier
i,HWType
ty)  <- Component -> [(Identifier, HWType)]
inputs Component
c  ]
  outPorts :: Ap (State SystemVerilogState) [Doc]
outPorts = [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ (Maybe Usage, Bool)
-> (Identifier, HWType) -> Maybe Expr -> SystemVerilogM Doc
forall {a} {a}.
Pretty a =>
(Maybe a, Bool) -> (a, HWType) -> Maybe Expr -> SystemVerilogM Doc
sigPort (Usage -> Maybe Usage
forall a. a -> Maybe a
Just Usage
u,Bool
False) (Identifier, HWType)
p Maybe Expr
iEM | (Usage
u, (Identifier, HWType)
p, Maybe Expr
iEM) <- Component -> [(Usage, (Identifier, HWType), Maybe Expr)]
outputs Component
c ]

  -- NOTE [net types and data types]
  --
  -- SystemVerilog makes a distinction between the type of a net and the data
  -- type of a signal. For output ports / inout ports this is fine, as there
  -- is only one possible type. For input ports when using `default_nettype none
  -- we have to specify the net type as wire explicitly (or vendor tools will
  -- claim the net from the port declaration is implicitly defined).

  wr2ty :: (Maybe a, Bool) -> a
wr2ty (Maybe a
Nothing,Bool
isBidirectional)
    | Bool
isBidirectional
    = a
"inout" -- no net type here, it gets added by verilogType.
    | Bool
otherwise
    = a
"input wire" -- See NOTE [net types and data types]
  wr2ty (Just a
_,Bool
_)
    = a
"output"

  -- map a port to its verilog type, port name, and any encoding notes
  sigPort :: (Maybe a, Bool) -> (a, HWType) -> Maybe Expr -> SystemVerilogM Doc
sigPort ((Maybe a, Bool) -> SystemVerilogM Doc
forall {a} {a}. IsString a => (Maybe a, Bool) -> a
wr2ty -> SystemVerilogM Doc
portTy) (a
nm, HWType
hwTy) Maybe Expr
iEM
    = [Attr Text] -> SystemVerilogM Doc -> SystemVerilogM Doc
addAttrs (HWType -> [Attr Text]
hwTypeAttrs HWType
hwTy)
        (SystemVerilogM Doc
portTy SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl (a -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty a
nm) HWType
hwTy SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
iE SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> SystemVerilogM Doc
forall (m :: Type -> Type). Applicative m => HWType -> m Doc
encodingNote HWType
hwTy)
    where
      iE :: SystemVerilogM Doc
iE = SystemVerilogM Doc
-> (Expr -> SystemVerilogM Doc) -> Maybe Expr -> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (SystemVerilogM Doc -> SystemVerilogM Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Expr -> SystemVerilogM Doc) -> Expr -> SystemVerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False) Maybe Expr
iEM
  -- slightly more readable than 'tupled', makes the output Haskell-y-er
  commafy :: Doc -> f Doc
commafy Doc
v = (f Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
space) f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> f Doc
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
v

  tupleInputs :: m [Doc] -> m Doc
tupleInputs m [Doc]
v = m [Doc]
v m [Doc] -> ([Doc] -> m Doc) -> m Doc
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    []     -> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"// No inputs" m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
    (Doc
x:[Doc]
xs) -> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
lparen m Doc -> m Doc -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"// Inputs"
                    m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"  " m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
x)
                    m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m [Doc] -> m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> (Doc -> m Doc) -> m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Doc]
xs Doc -> m Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f) =>
Doc -> f Doc
commafy)
                    m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line

  tupleOutputs :: m [Doc] -> m Doc
tupleOutputs m [Doc]
v = m [Doc]
v m [Doc] -> ([Doc] -> m Doc) -> m Doc
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    []     -> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"  // No outputs" m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen
    (Doc
x:[Doc]
xs) -> Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"  // Outputs"
                m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (if ([(Identifier, HWType)] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (Component -> [(Identifier, HWType)]
inputs Component
c)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                       then m Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
space m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
x
                       else Text -> m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"  " m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> m Doc
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
x)
                m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> (if [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
xs then m Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m [Doc] -> m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat ([Doc] -> (Doc -> m Doc) -> m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Doc]
xs Doc -> m Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f) =>
Doc -> f Doc
commafy))
                m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
forall (f :: Type -> Type). Applicative f => f Doc
rparen

verilogType :: HWType -> SystemVerilogM Doc
verilogType :: HWType -> SystemVerilogM Doc
verilogType HWType
t_ = do
  HWType
t <- HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
t_
  State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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)
  let logicOrWire :: SystemVerilogM Doc
logicOrWire | HWType -> Bool
isBiSignalIn HWType
t = SystemVerilogM Doc
"wire"
                  | Bool
otherwise      = SystemVerilogM Doc
"logic"
  Bool
pkgCtx <- State SystemVerilogState Bool -> Ap (State SystemVerilogState) Bool
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Bool
 -> Ap (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Ap (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> State SystemVerilogState Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
tyPkgCtx
  Text
nm <- State SystemVerilogState Text -> Ap (State SystemVerilogState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Text
 -> Ap (State SystemVerilogState) Text)
-> State SystemVerilogState Text
-> Ap (State SystemVerilogState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text SystemVerilogState Text
-> State SystemVerilogState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text SystemVerilogState Text
Lens' SystemVerilogState Text
modNm
  let pvrType :: SystemVerilogM Doc
pvrType = if Bool
pkgCtx
                then HWType -> SystemVerilogM Doc
tyName HWType
t
                else Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
nm SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
t
  case HWType
t of
    Product {}    -> SystemVerilogM Doc
pvrType
    Vector {}     -> SystemVerilogM Doc
pvrType
    RTree {}      -> SystemVerilogM Doc
pvrType
    Signed Int
n      -> SystemVerilogM Doc
logicOrWire SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"signed" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
    Clock Text
_       -> SystemVerilogM Doc
"logic"
    ClockN Text
_      -> SystemVerilogM Doc
"logic"
    Reset Text
_       -> SystemVerilogM Doc
"logic"
    Enable Text
_      -> SystemVerilogM Doc
"logic"
    HWType
Bit           -> SystemVerilogM Doc
"logic"
    HWType
Bool          -> SystemVerilogM Doc
"logic"
    HWType
String        -> SystemVerilogM Doc
"string"
    HWType
FileType      -> SystemVerilogM Doc
"integer"
    HWType
_ -> SystemVerilogM Doc
logicOrWire SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)

sigDecl :: SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl :: SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl SystemVerilogM Doc
d HWType
t = HWType -> SystemVerilogM Doc
verilogType HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
d

-- | Convert a Netlist HWType to the root of a Verilog type
verilogTypeMark :: HWType -> SystemVerilogM Doc
verilogTypeMark :: HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t_ = do
  HWType
t <- HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
t_
  State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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)
  Bool
pkgCtx <- State SystemVerilogState Bool -> Ap (State SystemVerilogState) Bool
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Bool
 -> Ap (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Ap (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> State SystemVerilogState Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
tyPkgCtx
  Text
nm <- State SystemVerilogState Text -> Ap (State SystemVerilogState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Text
 -> Ap (State SystemVerilogState) Text)
-> State SystemVerilogState Text
-> Ap (State SystemVerilogState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text SystemVerilogState Text
-> State SystemVerilogState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text SystemVerilogState Text
Lens' SystemVerilogState Text
modNm
  let pvrType :: SystemVerilogM Doc
pvrType = if Bool
pkgCtx
                then HWType -> SystemVerilogM Doc
tyName HWType
t
                else Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
nm SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
t
  case HWType
t of
    Product {} -> SystemVerilogM Doc
pvrType
    Vector {}  -> SystemVerilogM Doc
pvrType
    RTree {}   -> SystemVerilogM Doc
pvrType
    HWType
_ -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc

tyName :: HWType -> SystemVerilogM Doc
tyName :: HWType -> SystemVerilogM Doc
tyName HWType
Bool                  = SystemVerilogM Doc
"logic"
tyName HWType
Bit                   = SystemVerilogM Doc
"logic"
tyName (Vector Int
n HWType
elTy)       = SystemVerilogM Doc
"array_of_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
elTy
tyName (MemBlob Int
n Int
m)         = HWType -> SystemVerilogM Doc
tyName (Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m))
tyName (RTree Int
n HWType
elTy)        = SystemVerilogM Doc
"tree_of_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
elTy
tyName (BitVector Int
n)         = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n
tyName t :: HWType
t@(Index Integer
_)           = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t)
tyName (Signed Int
n)            = SystemVerilogM Doc
"signed_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n
tyName (Unsigned Int
n)          = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n
tyName t :: HWType
t@(Sum Text
_ [Text]
_)           = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t)
tyName t :: HWType
t@(CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
_) = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t)
tyName t :: HWType
t@(CustomSP Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text, [HWType])]
_)  = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t)
tyName t :: HWType
t@(Product Text
nm Maybe [Text]
_ [HWType]
_)      = do
  HWType
tN <- HWType -> Ap (State SystemVerilogState) HWType
normaliseType HWType
t
  Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
PP.pretty (Identifier -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) Identifier -> SystemVerilogM Doc
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< State SystemVerilogState Identifier
-> Ap (State SystemVerilogState) Identifier
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (HWType
-> Lens' SystemVerilogState (HashMap HWType Identifier)
-> State SystemVerilogState Identifier
-> State SystemVerilogState 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
tN (HashMap HWType Identifier -> f (HashMap HWType Identifier))
-> SystemVerilogState -> f SystemVerilogState
Lens' SystemVerilogState (HashMap HWType Identifier)
nameCache State SystemVerilogState Identifier
prodName)
 where
  prodName :: State SystemVerilogState Identifier
  prodName :: State SystemVerilogState Identifier
prodName = Text -> Text -> State SystemVerilogState Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> Text -> m Identifier
Id.makeBasicOr ([Text] -> Text
forall a. HasCallStack => [a] -> a
last (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
TextS.splitOn Text
"." Text
nm)) Text
"product"

tyName t :: HWType
t@(SP Text
_ [(Text, [HWType])]
_) = SystemVerilogM Doc
"logic_vector_" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
t)
tyName (Clock Text
_)  = SystemVerilogM Doc
"logic"
tyName (ClockN Text
_) = SystemVerilogM Doc
"logic"
tyName (Reset Text
_)  = SystemVerilogM Doc
"logic"
tyName (Enable Text
_) = SystemVerilogM Doc
"logic"
tyName HWType
t =  [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"tyName: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HWType -> [Char]
forall a. Show a => a -> [Char]
show HWType
t

-- | Convert a Netlist HWType to an error SystemVerilog value for that type
verilogTypeErrValue :: HWType -> SystemVerilogM Doc
verilogTypeErrValue :: HWType -> SystemVerilogM Doc
verilogTypeErrValue (Vector Int
n HWType
elTy) = do
  HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> Char -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'\'' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> SystemVerilogM Doc
singularErrValue HWType
elTy))
    HdlSyn
_ -> Char -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'\'' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> SystemVerilogM Doc
verilogTypeErrValue HWType
elTy))
verilogTypeErrValue (RTree Int
n HWType
elTy) = do
  HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  case HdlSyn
syn of
    HdlSyn
Vivado -> Char -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'\'' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> SystemVerilogM Doc
singularErrValue HWType
elTy))
    HdlSyn
_ -> Char -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Char -> f Doc
char Char
'\'' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM 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) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> SystemVerilogM Doc
verilogTypeErrValue HWType
elTy))
verilogTypeErrValue HWType
String = SystemVerilogM Doc
"\"ERROR\""
verilogTypeErrValue HWType
ty = HWType -> SystemVerilogM Doc
singularErrValue HWType
ty

singularErrValue :: HWType -> SystemVerilogM Doc
singularErrValue :: HWType -> SystemVerilogM Doc
singularErrValue HWType
ty = do
  Maybe (Maybe Int)
udf <- State SystemVerilogState (Maybe (Maybe Int))
-> Ap (State SystemVerilogState) (Maybe (Maybe Int))
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (Getting (Maybe (Maybe Int)) SystemVerilogState (Maybe (Maybe Int))
-> State SystemVerilogState (Maybe (Maybe Int))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (Maybe (Maybe Int)) SystemVerilogState (Maybe (Maybe Int))
Lens' SystemVerilogState (Maybe (Maybe Int))
undefValue)
  case Maybe (Maybe Int)
udf of
    Maybe (Maybe Int)
Nothing       -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces SystemVerilogM Doc
"1'bx")
    Just Maybe Int
Nothing  -> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'d0 /* undefined */"
    Just (Just Int
x) -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (SystemVerilogM Doc
"1'b" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"/* undefined */"

verilogRecSel
  :: HWType
  -> Int
  -> SystemVerilogM Doc
verilogRecSel :: HWType -> Int -> SystemVerilogM Doc
verilogRecSel HWType
ty Int
i = HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_sel" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i

decls :: [Declaration] -> SystemVerilogM Doc
decls :: [Declaration] -> SystemVerilogM Doc
decls [] = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
decls [Declaration]
ds = do
    [Doc]
dsDoc <- [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Doc] -> [Doc])
-> Ap (State SystemVerilogState) [Maybe Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (Declaration -> Ap (State SystemVerilogState) (Maybe Doc))
-> [Declaration] -> Ap (State SystemVerilogState) [Maybe Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
decl [Declaration]
ds
    case [Doc]
dsDoc of
      [] -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      [Doc]
_  -> SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (m :: Type -> Type).
Monad m =>
Ap m Doc -> Ap m [Doc] -> Ap m Doc
punctuate' SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi ([Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
A.pure [Doc]
dsDoc)

decl :: Declaration -> SystemVerilogM (Maybe Doc)
decl :: Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
decl (NetDecl' Maybe Text
noteM Identifier
id_ HWType
tyE Maybe Expr
iEM) =
  Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Text -> SystemVerilogM Doc -> SystemVerilogM Doc)
-> Maybe Text
-> SystemVerilogM Doc
-> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc -> SystemVerilogM Doc
forall a. a -> a
id Text -> SystemVerilogM Doc -> SystemVerilogM Doc
forall {f :: Type -> Type}.
(Monoid (f Doc), Applicative f, IsString (f Doc)) =>
Text -> f Doc -> f Doc
addNote Maybe Text
noteM ([Attr Text] -> SystemVerilogM Doc -> SystemVerilogM Doc
addAttrs [Attr Text]
attrs (HWType -> SystemVerilogM Doc
typ HWType
tyE))
  where
    typ :: HWType -> SystemVerilogM Doc
typ HWType
ty = SystemVerilogM Doc -> HWType -> SystemVerilogM Doc
sigDecl (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_) HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
iE
    addNote :: Text -> f Doc -> f Doc
addNote Text
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
<+> Text -> f Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
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)
    attrs :: [Attr Text]
attrs = [Attr Text] -> Maybe [Attr Text] -> [Attr Text]
forall a. a -> Maybe a -> a
fromMaybe [] (HWType -> [Attr Text]
hwTypeAttrs (HWType -> [Attr Text]) -> Maybe HWType -> Maybe [Attr Text]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
A.<$> HWType -> Maybe HWType
forall a. a -> Maybe a
Just HWType
tyE)
    iE :: SystemVerilogM Doc
iE = SystemVerilogM Doc
-> (Expr -> SystemVerilogM Doc) -> Maybe Expr -> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc (SystemVerilogM Doc -> SystemVerilogM Doc
forall (m :: Type -> Type).
(Monad m, Semigroup (m Doc)) =>
m Doc -> m Doc
noEmptyInit (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Expr -> SystemVerilogM Doc) -> Expr -> SystemVerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False) Maybe Expr
iEM

decl Declaration
_ = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

-- | Convert single attribute to systemverilog syntax
renderAttr :: Attr TextS.Text -> TextS.Text
renderAttr :: Attr Text -> Text
renderAttr (StringAttr  Text
key Text
value) = [Text] -> Text
TextS.concat [Text
key, Text
" = ", [Char] -> Text
TextS.pack (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
value)]
renderAttr (IntegerAttr Text
key Integer
value) = [Text] -> Text
TextS.concat [Text
key, Text
" = ", [Char] -> Text
TextS.pack (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
value)]
renderAttr (BoolAttr    Text
key Bool
True ) = [Text] -> Text
TextS.concat [Text
key, Text
" = ", Text
"1"]
renderAttr (BoolAttr    Text
key Bool
False) = [Text] -> Text
TextS.concat [Text
key, Text
" = ", Text
"0"]
renderAttr (Attr        Text
key      ) = Text
key

-- | Add attribute notation to given declaration
addAttrs
  :: [Attr TextS.Text]
  -> SystemVerilogM Doc
  -> SystemVerilogM Doc
addAttrs :: [Attr Text] -> SystemVerilogM Doc -> SystemVerilogM Doc
addAttrs []     SystemVerilogM Doc
t = SystemVerilogM Doc
t
addAttrs [Attr Text]
attrs' SystemVerilogM Doc
t =
  SystemVerilogM Doc
"(*" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
attrs'' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"*)" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
t
    where
      attrs'' :: SystemVerilogM Doc
attrs'' = Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS (Text -> SystemVerilogM Doc) -> Text -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
TextS.intercalate Text
", " ((Attr Text -> Text) -> [Attr Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Attr Text -> Text
renderAttr [Attr Text]
attrs')

insts :: [Declaration] -> SystemVerilogM Doc
insts :: [Declaration] -> SystemVerilogM Doc
insts [] = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
insts (TickDecl (Comment Text
c):[Declaration]
ds) = Text -> Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> Text -> f Doc
comment Text
"//" Text
c SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds
insts (TickDecl (Directive Text
d):[Declaration]
ds) = Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
";" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds
insts (Declaration
d:[Declaration]
ds) = do
  Maybe Doc
docM <- Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
inst_ Declaration
d
  case Maybe Doc
docM of
    Maybe Doc
Nothing -> [Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds
    Just Doc
doc -> Doc -> SystemVerilogM Doc
forall a. a -> Ap (State SystemVerilogState) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
doc SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds

stdMatch
  :: Bits a
  => Int
  -> a
  -> a
  -> String
stdMatch :: forall a. Bits a => Int -> a -> a -> [Char]
stdMatch Int
0 a
_mask a
_value = []
stdMatch Int
size a
mask a
value =
  Char
symbol Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> a -> a -> [Char]
forall a. Bits a => Int -> a -> a -> [Char]
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'
  :: Int
  -> ConstrRepr'
  -> SystemVerilogM Doc
patLitCustom' :: Int -> ConstrRepr' -> SystemVerilogM Doc
patLitCustom' Int
size (ConstrRepr' Text
_name Int
_n Integer
mask Integer
value [Integer]
_anns) =
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
size SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"b" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> SystemVerilogM Doc) -> Text -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> [Char]
forall a. Bits a => Int -> a -> a -> [Char]
stdMatch Int
size Integer
mask Integer
value)

patLitCustom
  :: HWType
  -> Literal
  -> SystemVerilogM Doc
patLitCustom :: HWType -> Literal -> SystemVerilogM Doc
patLitCustom (CustomSum Text
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Text)]
reprs) (NumLit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i)) =
  Int -> ConstrRepr' -> SystemVerilogM Doc
patLitCustom' Int
size ((ConstrRepr', Text) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Text) -> ConstrRepr')
-> (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Text)]
reprs [(ConstrRepr', Text)] -> Int -> (ConstrRepr', Text)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)

patLitCustom (CustomSP Text
_name DataRepr'
_dataRepr Int
size [(ConstrRepr', Text, [HWType])]
reprs) (NumLit (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i)) =
  let (ConstrRepr'
cRepr, Text
_id, [HWType]
_tys) = [(ConstrRepr', Text, [HWType])]
reprs [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  Int -> ConstrRepr' -> SystemVerilogM Doc
patLitCustom' Int
size ConstrRepr'
cRepr

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

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

-- | Helper function for inst_, handling CustomSP and CustomSum
inst_' :: Identifier -> Expr -> HWType -> [(Maybe Literal, Expr)] -> SystemVerilogM (Maybe Doc)
inst_' :: Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State SystemVerilogState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es = (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc))
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  SystemVerilogM Doc
"always_comb begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 SystemVerilogM Doc
casez SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"end"
    where
      casez :: SystemVerilogM Doc
casez =
        SystemVerilogM Doc
"casez" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
var SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
          Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([(Maybe Literal, Expr)] -> SystemVerilogM Doc
conds [(Maybe Literal, Expr)]
esNub) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        SystemVerilogM Doc
"endcase"

      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 b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Literal -> Literal) -> Maybe Literal -> Maybe Literal
forall a b. (a -> b) -> Maybe a -> Maybe b
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 :: SystemVerilogM Doc
var   = Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
scrut

      conds :: [(Maybe Literal,Expr)] -> SystemVerilogM Doc
      conds :: [(Maybe Literal, Expr)] -> SystemVerilogM Doc
conds []                = [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Empty list of conditions invalid."
      conds [(Maybe Literal
_,Expr
e)]           = SystemVerilogM Doc
"default" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
":" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
";"
      conds ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_)   = SystemVerilogM Doc
"default" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
":" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
";"
      conds ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') =
        SystemVerilogM Doc
mask' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
":" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"=" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
";" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [(Maybe Literal, Expr)] -> SystemVerilogM Doc
conds [(Maybe Literal, Expr)]
es'
          where
            mask' :: SystemVerilogM Doc
mask' = HWType -> Literal -> SystemVerilogM Doc
patLitCustom HWType
scrutTy Literal
c

-- | Turn a Netlist Declaration to a SystemVerilog concurrent block
inst_ :: Declaration -> SystemVerilogM (Maybe Doc)
inst_ :: Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
inst_ (TickDecl {}) = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

inst_ (CompDecl {}) = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

inst_ (Assignment Identifier
id_ Usage
Cont Expr
e) = (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc))
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
  SystemVerilogM Doc
"assign" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)

inst_ (CondAssignment Identifier
id_ HWType
ty Expr
scrut HWType
_ [(Just (BoolLit Bool
b), Expr
l),(Maybe Literal
_,Expr
r)]) = (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc))
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$ do
    { HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    ; [Identifier]
p   <- State SystemVerilogState [Identifier]
-> Ap (State SystemVerilogState) [Identifier]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState [Identifier]
 -> Ap (State SystemVerilogState) [Identifier])
-> State SystemVerilogState [Identifier]
-> Ap (State SystemVerilogState) [Identifier]
forall a b. (a -> b) -> a -> b
$ Getting [Identifier] SystemVerilogState [Identifier]
-> State SystemVerilogState [Identifier]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Identifier] SystemVerilogState [Identifier]
Lens' SystemVerilogState [Identifier]
oports
    ; if HdlSyn
syn HdlSyn -> HdlSyn -> Bool
forall a. Eq a => a -> a -> Bool
== HdlSyn
Vivado Bool -> Bool -> Bool
&& Identifier
id_ Identifier -> [Identifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Identifier]
p
         then do
              { Identifier
regId <- Identifier -> Text -> Ap (State SystemVerilogState) Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Identifier -> Text -> m Identifier
Id.suffix Identifier
id_ Text
"reg"
              ; HWType -> SystemVerilogM Doc
verilogType HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
regId SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                SystemVerilogM Doc
"always_comb begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
"if" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
scrut) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                            (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
regId SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                         SystemVerilogM Doc
"else" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                            (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
regId SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
f SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                SystemVerilogM Doc
"end" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                SystemVerilogM Doc
"assign" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
regId SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
              }
         else SystemVerilogM Doc
"always_comb begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
"if" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
scrut) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                          (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                       SystemVerilogM Doc
"else" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                          (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
f SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              SystemVerilogM Doc
"end"
    }
  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 {}) [(Maybe Literal, Expr)]
es) =
  Identifier
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Ap (State SystemVerilogState) (Maybe Doc)
inst_' Identifier
id_ Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es

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

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

inst_ (CondAssignment Identifier
id_ HWType
ty Expr
scrut HWType
scrutTy [(Maybe Literal, Expr)]
es) = (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc))
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$ do
    { HdlSyn
syn <- State SystemVerilogState HdlSyn
-> Ap (State SystemVerilogState) HdlSyn
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap State SystemVerilogState HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
    ; [Identifier]
p <- State SystemVerilogState [Identifier]
-> Ap (State SystemVerilogState) [Identifier]
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState [Identifier]
 -> Ap (State SystemVerilogState) [Identifier])
-> State SystemVerilogState [Identifier]
-> Ap (State SystemVerilogState) [Identifier]
forall a b. (a -> b) -> a -> b
$ Getting [Identifier] SystemVerilogState [Identifier]
-> State SystemVerilogState [Identifier]
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting [Identifier] SystemVerilogState [Identifier]
Lens' SystemVerilogState [Identifier]
oports
    ; if HdlSyn
syn HdlSyn -> HdlSyn -> Bool
forall a. Eq a => a -> a -> Bool
== HdlSyn
Vivado Bool -> Bool -> Bool
&& Identifier
id_ Identifier -> [Identifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Identifier]
p
         then do
           { Identifier
regId <- Identifier -> Text -> Ap (State SystemVerilogState) Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Identifier -> Text -> m Identifier
Id.suffix Identifier
id_ Text
"reg"
           ; HWType -> SystemVerilogM Doc
verilogType HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
regId SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
             SystemVerilogM Doc
"always_comb begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
             Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
"case" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
scrut) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                         (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi (Identifier
-> [(Maybe Literal, Expr)] -> Ap (State SystemVerilogState) [Doc]
conds Identifier
regId [(Maybe Literal, Expr)]
es)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                       SystemVerilogM Doc
"endcase") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
             SystemVerilogM Doc
"end" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
             SystemVerilogM Doc
"assign" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
regId SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi
           }
         else SystemVerilogM Doc
"always_comb begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc
"case" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
scrut) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                          (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi (Identifier
-> [(Maybe Literal, Expr)] -> Ap (State SystemVerilogState) [Doc]
conds Identifier
id_ [(Maybe Literal, Expr)]
es)) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
                        SystemVerilogM Doc
"endcase") SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
              SystemVerilogM Doc
"end"
    }
  where
    conds :: Identifier -> [(Maybe Literal,Expr)] -> SystemVerilogM [Doc]
    conds :: Identifier
-> [(Maybe Literal, Expr)] -> Ap (State SystemVerilogState) [Doc]
conds Identifier
_ []                = [Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds Identifier
i [(Maybe Literal
_,Expr
e)]           = (SystemVerilogM Doc
"default" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e) SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds Identifier
i ((Maybe Literal
Nothing,Expr
e):[(Maybe Literal, Expr)]
_)   = (SystemVerilogM Doc
"default" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e) SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    conds Identifier
i ((Just Literal
c ,Expr
e):[(Maybe Literal, Expr)]
es') = (Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
scrutTy,HWType -> Int
conSize HWType
scrutTy)) Literal
c SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
i SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e) SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Identifier
-> [(Maybe Literal, Expr)] -> Ap (State SystemVerilogState) [Doc]
conds Identifier
i [(Maybe Literal, Expr)]
es'

inst_ (InstDecl EntityOrComponent
_ Maybe Text
_ [Attr Text]
attrs Identifier
nm Identifier
lbl [(Expr, HWType, Expr)]
ps PortMap
pms0) = (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Maybe Doc
forall a. a -> Maybe a
Just (SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc))
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b. (a -> b) -> a -> b
$
    SystemVerilogM Doc
attrs' SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
nm SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
params SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
lbl SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
pms2 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi)
  where
    pms2 :: SystemVerilogM Doc
pms2 = case PortMap
pms0 of
      NamedPortMap [(Expr, PortDirection, HWType, Expr)]
pms1 ->
        let pm :: Expr -> Expr -> SystemVerilogM Doc
pm Expr
i Expr
e = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
i SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e) in
        Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [Expr -> Expr -> SystemVerilogM Doc
pm Expr
i Expr
e | (Expr
i,PortDirection
_,HWType
_,Expr
e) <- [(Expr, PortDirection, HWType, Expr)]
pms1]
      IndexedPortMap [(PortDirection, HWType, Expr)]
pms1 ->
        Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e | (PortDirection
_,HWType
_,Expr
e) <- [(PortDirection, HWType, Expr)]
pms1]

    params :: SystemVerilogM Doc
params
      | [(Expr, HWType, Expr)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(Expr, HWType, Expr)]
ps   = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
space
      | Bool
otherwise = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"#" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
tupled ([SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
i SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e) | (Expr
i,HWType
_,Expr
e) <- [(Expr, HWType, Expr)]
ps]) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line
    attrs' :: SystemVerilogM Doc
attrs'
      | [Attr Text] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Attr Text]
attrs = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
      | Bool
otherwise  = [Attr Text] -> SystemVerilogM Doc -> SystemVerilogM Doc
addAttrs [Attr Text]
attrs SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line

inst_ (BlackBoxD Text
_ [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx) =
  (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
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 SystemVerilogState Doc -> SystemVerilogM Doc
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState (Int -> Doc)
-> State SystemVerilogState Doc
forall (f :: Type -> Type). Functor f => f (Int -> Doc) -> f Doc
column ([BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State SystemVerilogState (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Text, Text), BlackBox)]
inc BlackBox
bs BlackBoxContext
bbCtx)))

inst_ (Seq [Seq]
ds) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Seq] -> SystemVerilogM Doc
seqs [Seq]
ds

inst_ (NetDecl' {}) = Maybe Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Doc
forall a. Maybe a
Nothing

inst_ (ConditionalDecl Text
cond [Declaration]
ds) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) (Maybe Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
  SystemVerilogM Doc
"`ifdef" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
cond SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Declaration] -> SystemVerilogM Doc
insts [Declaration]
ds) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"`endif"

inst_ Declaration
d =
  [Char] -> Ap (State SystemVerilogState) (Maybe Doc)
forall a. HasCallStack => [Char] -> a
error ([Char]
"inst_: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Declaration -> [Char]
forall a. Show a => a -> [Char]
show Declaration
d)

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

      -- Build bit representations for all constructor arguments
      argExprs :: [SystemVerilogM Doc]
argExprs = ((HWType, Expr) -> SystemVerilogM Doc)
-> [(HWType, Expr)] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((HWType -> Expr -> SystemVerilogM Doc)
-> (HWType, Expr) -> SystemVerilogM Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HWType -> Expr -> SystemVerilogM Doc
toSLV) [(HWType, Expr)]
args :: [SystemVerilogM Doc]

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

      range'
        :: BitOrigin
        -> SystemVerilogM Doc
      range' :: BitOrigin -> SystemVerilogM Doc
range' (Lit ([Bit] -> [Bit]
bitsToBits -> [Bit]
ns)) =
        Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int ([Bit] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Bit]
ns) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"b" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Bit -> SystemVerilogM Doc)
-> [Bit] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Lens' SystemVerilogState (Maybe (Maybe Int))
-> Bit -> SystemVerilogM Doc
forall s. Lens' s (Maybe (Maybe Int)) -> Bit -> Ap (State s) Doc
bit_char (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> SystemVerilogState -> f SystemVerilogState
Lens' SystemVerilogState (Maybe (Maybe Int))
undefValue) [Bit]
ns)
      range' (Field Int
n Int
start Int
end) =
        -- We want to select the bits starting from 'start' downto and including
        -- 'end'. We cannot use slice notation in Verilog, as the preceding
        -- expression might not be an identifier.
        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' :: SystemVerilogM Doc
expr' = [SystemVerilogM Doc]
argExprs [SystemVerilogM Doc] -> Int -> SystemVerilogM Doc
forall a. HasCallStack => [a] -> Int -> a
!! Int
n in

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

seq_ :: Seq -> SystemVerilogM Doc
seq_ :: Seq -> SystemVerilogM Doc
seq_ (AlwaysClocked ActiveEdge
edge Expr
clk [Seq]
ds) =
  SystemVerilogM Doc
"always @" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (case ActiveEdge
edge of {ActiveEdge
Rising -> SystemVerilogM Doc
"posedge"; ActiveEdge
_ -> SystemVerilogM Doc
"negedge"} SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+>
            Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
clk) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> SystemVerilogM Doc
seqs [Seq]
ds) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"end"

seq_ (Initial [Seq]
ds) =
  SystemVerilogM Doc
"initial begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> SystemVerilogM Doc
seqs [Seq]
ds) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"end"

seq_ (AlwaysComb [Seq]
ds) =
  SystemVerilogM Doc
"always @* begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> SystemVerilogM Doc
seqs [Seq]
ds) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
  SystemVerilogM Doc
"end"

seq_ (Branch Expr
scrut HWType
scrutTy [(Maybe Literal, [Seq])]
es) =
    SystemVerilogM Doc
"case" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
scrut) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
      (Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ [(Maybe Literal, [Seq])] -> Ap (State SystemVerilogState) [Doc]
conds [(Maybe Literal, [Seq])]
es) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
    SystemVerilogM Doc
"endcase"
   where
        conds :: [(Maybe Literal,[Seq])] -> SystemVerilogM [Doc]
        conds :: [(Maybe Literal, [Seq])] -> Ap (State SystemVerilogState) [Doc]
conds [] =
          [Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
        conds [(Maybe Literal
_,[Seq]
sq)] =
          (SystemVerilogM Doc
"default" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> SystemVerilogM Doc
seqs [Seq]
sq) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
          SystemVerilogM Doc
"end") SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
        conds ((Maybe Literal
Nothing,[Seq]
sq):[(Maybe Literal, [Seq])]
_) =
          (SystemVerilogM Doc
"default" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> SystemVerilogM Doc
seqs [Seq]
sq) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
          SystemVerilogM Doc
"end") SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc] -> Ap (State SystemVerilogState) [Doc]
forall a. a -> Ap (State SystemVerilogState) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
        conds ((Just Literal
c ,[Seq]
sq):[(Maybe Literal, [Seq])]
es') =
          (Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (HWType
scrutTy,HWType -> Int
conSize HWType
scrutTy)) Literal
c SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"begin" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
            Int -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
indent Int
2 ([Seq] -> SystemVerilogM Doc
seqs [Seq]
sq) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
          SystemVerilogM Doc
"end") SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [(Maybe Literal, [Seq])] -> Ap (State SystemVerilogState) [Doc]
conds [(Maybe Literal, [Seq])]
es'

seq_ (SeqDecl Declaration
sd) = case Declaration
sd of
  Assignment Identifier
id_ (Proc Blocking
b) Expr
e ->
    let sym :: SystemVerilogM Doc
sym = case Blocking
b of { Blocking
Blocking -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
equals; Blocking
NonBlocking -> SystemVerilogM Doc
"<=" }
     in Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
sym SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
semi

  BlackBoxD {} ->
    Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe (Doc -> Maybe Doc -> Doc)
-> SystemVerilogM Doc
-> Ap (State SystemVerilogState) (Maybe Doc -> Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc Ap (State SystemVerilogState) (Maybe Doc -> Doc)
-> Ap (State SystemVerilogState) (Maybe Doc) -> SystemVerilogM Doc
forall a b.
Ap (State SystemVerilogState) (a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Declaration -> Ap (State SystemVerilogState) (Maybe Doc)
inst_ Declaration
sd

  Seq [Seq]
ds ->
    [Seq] -> SystemVerilogM Doc
seqs [Seq]
ds

  Declaration
_ -> [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error (Declaration -> [Char]
forall a. Show a => a -> [Char]
show Declaration
sd)

seqs :: [Seq] -> SystemVerilogM Doc
seqs :: [Seq] -> SystemVerilogM Doc
seqs [] = SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc
seqs (SeqDecl (TickDecl (Comment Text
c)):[Seq]
ds) = Text -> Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> Text -> f Doc
comment Text
"//" Text
c SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> SystemVerilogM Doc
seqs [Seq]
ds
seqs (SeqDecl (TickDecl (Directive Text
d)):[Seq]
ds) = Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
";" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> SystemVerilogM Doc
seqs [Seq]
ds
seqs (Seq
d:[Seq]
ds) = Seq -> SystemVerilogM Doc
seq_ Seq
d SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
line SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> [Seq] -> SystemVerilogM Doc
seqs [Seq]
ds

-- | Turn a Netlist expression into a SystemVerilog expression
expr_ :: Bool -- ^ Enclose in parentheses?
      -> Expr -- ^ Expr to convert
      -> SystemVerilogM Doc
expr_ :: Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
_ (Literal Maybe (HWType, Int)
sizeM Literal
lit) = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV Maybe (HWType, Int)
sizeM Literal
lit
expr_ Bool
_ (Identifier Identifier
id_ Maybe Modifier
Nothing) = Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed (CustomSP Text
_id DataRepr'
dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
args,Int
dcI,Int
fI)))) =
  case HWType
fieldTy of
    Void {} ->
      [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error (DataRepr' -> Int -> Int -> [Char]
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    HWType
_ ->
      HWType -> SystemVerilogM Doc -> SystemVerilogM Doc
expFromSLV HWType
fieldTy (SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate SystemVerilogM Doc
", " (Ap (State SystemVerilogState) [Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [SystemVerilogM Doc]
ranges)
 where
  (ConstrRepr' Text
_name Int
_n Integer
_mask Integer
_value [Integer]
anns, Text
_, [HWType]
fieldTypes) = [(ConstrRepr', Text, [HWType])]
args [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
dcI
  ranges :: [SystemVerilogM Doc]
ranges = ((Int, Int) -> SystemVerilogM Doc)
-> [(Int, Int)] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> SystemVerilogM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f, IsString (f Doc)) =>
(Int, Int) -> f Doc
range' ([(Int, Int)] -> [SystemVerilogM Doc])
-> [(Int, Int)] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> a -> b
$ Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI)
  range' :: (Int, Int) -> f Doc
range' (Int
start, Int
end) = Identifier -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ 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
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
":" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
  fieldTy :: HWType
fieldTy = [Char] -> [HWType] -> Int -> HWType
forall a. HasCallStack => [Char] -> [a] -> Int -> a
indexNote ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"panic") [HWType]
fieldTypes Int
fI

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed (CustomProduct Text
_id DataRepr'
dataRepr Int
_size Maybe [Text]
_maybeFieldNames [(Integer, HWType)]
args,Int
dcI,Int
fI)))) =
  case HWType
fieldTy of
    Void {} ->
      [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error (DataRepr' -> Int -> Int -> [Char]
unexpectedProjectionErrorMsg DataRepr'
dataRepr Int
dcI Int
fI)
    HWType
_ ->
      HWType -> SystemVerilogM Doc -> SystemVerilogM Doc
expFromSLV HWType
fieldTy (SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate SystemVerilogM Doc
", " (Ap (State SystemVerilogState) [Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [SystemVerilogM Doc]
ranges)
 where
  ([Integer]
anns, [HWType]
fieldTypes) = [(Integer, HWType)] -> ([Integer], [HWType])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Integer, HWType)]
args
  ranges :: [SystemVerilogM Doc]
ranges = ((Int, Int) -> SystemVerilogM Doc)
-> [(Int, Int)] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> SystemVerilogM Doc
forall {f :: Type -> Type}.
(Semigroup (f Doc), Applicative f, IsString (f Doc)) =>
(Int, Int) -> f Doc
range' ([(Int, Int)] -> [SystemVerilogM Doc])
-> [(Int, Int)] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> a -> b
$ Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI)
  range' :: (Int, Int) -> f Doc
range' (Int
start, Int
end) = Identifier -> f Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ 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
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
":" f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
  fieldTy :: HWType
fieldTy = [Char] -> [HWType] -> Int -> HWType
forall a. HasCallStack => [Char] -> [a] -> Int -> a
indexNote ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"panic") [HWType]
fieldTypes Int
fI

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args),Int
dcI,Int
fI)))) =
    HWType -> Text -> Int -> Int -> SystemVerilogM Doc
fromSLV HWType
argTy (Identifier -> Text
Id.toText Identifier
id_) Int
start Int
end
  where
    argTys :: [HWType]
argTys   = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Text, [HWType])]
args [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-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

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed (ty :: HWType
ty@(Product Text
_ Maybe [Text]
_ [HWType]
tys),Int
_,Int
fI)))) = do
  Text
id'<- (Doc -> Text)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) Text
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Text.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
dot SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_sel" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI)
  HWType -> Text -> SystemVerilogM Doc
simpleFromSLV ([HWType]
tys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI) Text
id'

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((Vector Int
_ HWType
elTy),Int
1,Int
0)))) = do
  Text
id' <- (Doc -> Text)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) Text
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Text.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0))
  HWType -> Text -> SystemVerilogM Doc
simpleFromSLV HWType
elTy Text
id'

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((Vector Int
n HWType
_),Int
1,Int
1)))) = Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
1 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

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

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((RTree Int
0 HWType
elTy),Int
0,Int
0)))) = do
  Text
id' <- (Doc -> Text)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) Text
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Text.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0))
  HWType -> Text -> SystemVerilogM Doc
simpleFromSLV HWType
elTy Text
id'

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((RTree Int
n HWType
_),Int
1,Int
0)))) =
  let z :: Int
z = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  in  Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((RTree Int
n HWType
_),Int
1,Int
1)))) =
  let z :: Int
z  = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> 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
n
  in Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
z SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
z'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((Vector Int
_ HWType
elTy),Int
10,Int
fI)))) = do
  Text
id' <- (Doc -> Text)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) Text
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Text.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI))
  HWType -> Text -> SystemVerilogM Doc
simpleFromSLV HWType
elTy Text
id'

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((RTree Int
_ HWType
elTy),Int
10,Int
fI)))) = do
  Text
id' <- (Doc -> Text)
-> SystemVerilogM Doc -> Ap (State SystemVerilogState) Text
forall a b.
(a -> b)
-> Ap (State SystemVerilogState) a
-> Ap (State SystemVerilogState) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Text.toStrict (Text -> Text) -> (Doc -> Text) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
fI))
  HWType -> Text -> SystemVerilogM Doc
simpleFromSLV HWType
elTy Text
id'

expr_ Bool
_ (Identifier Identifier
id_ (Just (DC (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
_),Int
_)))) = Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)
  where
    start :: Int
start = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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

expr_ Bool
_ (Identifier Identifier
id_ (Just m :: Modifier
m@Nested {})) = case Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
0 [] Modifier
m of
  Maybe ([Either NMod NMod], HWType)
Nothing -> Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_
  Just ([Either NMod NMod]
mods,HWType
resTy) -> do
    Text
nm <- State SystemVerilogState Text -> Ap (State SystemVerilogState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Text
 -> Ap (State SystemVerilogState) Text)
-> State SystemVerilogState Text
-> Ap (State SystemVerilogState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text SystemVerilogState Text
-> State SystemVerilogState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text SystemVerilogState Text
Lens' SystemVerilogState Text
modNm
    Bool
pkgCtx <- State SystemVerilogState Bool -> Ap (State SystemVerilogState) Bool
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Bool
 -> Ap (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Ap (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> State SystemVerilogState Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
tyPkgCtx
    let prefix :: SystemVerilogM Doc
prefix = if Bool
pkgCtx then SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
nm SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::"
    let e :: SystemVerilogM Doc
e = Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat ((Either NMod NMod -> SystemVerilogM Doc)
-> [Either NMod NMod] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM ((NMod -> SystemVerilogM Doc)
-> (NMod -> SystemVerilogM Doc)
-> Either NMod NMod
-> SystemVerilogM Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either NMod -> SystemVerilogM Doc
forall {f :: Type -> Type}.
(Applicative f, Semigroup (f Doc)) =>
NMod -> f Doc
bracketNMod NMod -> SystemVerilogM Doc
forall {f :: Type -> Type}.
(Applicative f, Semigroup (f Doc)) =>
NMod -> f Doc
bracketNMod) ([Either NMod NMod] -> [Either NMod NMod]
forall a. [a] -> [a]
reverse [Either NMod NMod]
mods))
    case HWType
resTy of
      Signed Int
_ -> SystemVerilogM Doc
"$signed" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
e
      Vector {}
        | Left (NRange {}):[Either NMod NMod]
_ <- [Either NMod NMod]
mods
        -> SystemVerilogM Doc
e
        | Bool
otherwise  -> do
        State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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
resTy)
        SystemVerilogM Doc
prefix SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
resTy SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
e
      RTree {}
        | Left (NRange {}):[Either NMod NMod]
_ <- [Either NMod NMod]
mods
        -> SystemVerilogM Doc
e
        | Bool
otherwise -> do
        State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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
resTy)
        SystemVerilogM Doc
prefix SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> HWType -> SystemVerilogM Doc
tyName HWType
resTy SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
e
      HWType
_ -> SystemVerilogM Doc
e
 where
  bracketNMod :: NMod -> f Doc
bracketNMod (NElem Int
i)    = f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i)
  bracketNMod (NRange Int
s Int
e) = f Doc -> f Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
s f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> f Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon f Doc -> f Doc -> f Doc
forall a. Semigroup a => a -> a -> a
<> Int -> f Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
e)

-- See [Note] integer projection
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((Signed Int
w),Int
_,Int
_))))  = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Bool -> [Char] -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Bool -> [Char] -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"WARNING: result smaller than argument") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_

-- See [Note] integer projection
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((Unsigned Int
w),Int
_,Int
_))))  = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Bool -> [Char] -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Bool -> [Char] -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"WARNING: result smaller than argument") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_

-- See [Note] mask projection
expr_ Bool
_ (Identifier Identifier
_ (Just (Indexed ((BitVector Int
_),Int
_,Int
0)))) = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Bool -> [Char] -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Bool -> [Char] -> a -> a
traceIf Bool
True ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"WARNING: synthesizing bitvector mask to dontcare") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$
    HWType -> SystemVerilogM Doc
verilogTypeErrValue (Int -> HWType
Unsigned Int
iw)

-- See [Note] bitvector projection
expr_ Bool
_ (Identifier Identifier
id_ (Just (Indexed ((BitVector Int
w),Int
_,Int
1)))) = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Bool -> [Char] -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Bool -> [Char] -> a -> a
traceIf (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w) ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"WARNING: result smaller than argument") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> SystemVerilogM Doc -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$
    Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_

expr_ Bool
_ (Identifier Identifier
id_ (Just (Sliced ((BitVector Int
_,Int
start,Int
end))))) =
  Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
":" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

expr_ Bool
_ (Identifier Identifier
id_ (Just Modifier
_)) = Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_

expr_ Bool
b (DataCon HWType
_ (DC (Void {}, -1)) [Expr
e]) =  Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
b Expr
e

expr_ Bool
_ (DataCon ty :: HWType
ty@(Vector Int
0 HWType
_) Modifier
_ [Expr]
_) = HWType -> SystemVerilogM Doc
verilogTypeErrValue HWType
ty

expr_ Bool
_ (DataCon (Vector Int
1 HWType
elTy) Modifier
_ [Expr
e]) = SystemVerilogM Doc
"'" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
elTy Expr
e)

expr_ Bool
_ e :: Expr
e@(DataCon ty :: HWType
ty@(Vector Int
_ HWType
elTy) Modifier
_ [Expr
e1,Expr
e2]) = case Expr -> Maybe [Expr]
vectorChain Expr
e of
  Just [Expr]
es -> SystemVerilogM Doc
"'" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Int -> Expr -> SystemVerilogM Doc)
-> [Int] -> [Expr] -> Ap (State SystemVerilogState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i Expr
e3 -> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
elTy Expr
e3) [Int
0..] [Expr]
es)
  Maybe [Expr]
Nothing -> HWType -> SystemVerilogM Doc
verilogTypeMark HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_cons" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e1 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e2)

expr_ Bool
_ (DataCon (MemBlob Int
n Int
m) Modifier
_ [Expr
n0, Expr
m0, Expr
_, Expr
runs, Expr
_, Expr
ends])
  | Literal Maybe (HWType, Int)
_ (NumLit Integer
n1) <- Expr
n0
  , Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n1
  , Literal Maybe (HWType, Int)
_ (NumLit Integer
m1) <- Expr
m0
  , Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m1
  , Literal Maybe (HWType, Int)
Nothing (StringLit [Char]
runs0) <- Expr
runs
  , Literal Maybe (HWType, Int)
Nothing (StringLit [Char]
ends0) <- Expr
ends
  , [Natural]
es <- Int -> Int -> ByteString -> ByteString -> [Natural]
unpackNats Int
n Int
m ([Char] -> ByteString
B8.pack [Char]
runs0) ([Char] -> ByteString
B8.pack [Char]
ends0) =
    let el :: a -> SystemVerilogM Doc
el a
val = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector Int
m, Int
m))
                           (Integer -> Integer -> Literal
BitVecLit Integer
0 (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall a. Integral a => a -> Integer
toInteger a
val)
    in SystemVerilogM Doc
"'" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Natural -> SystemVerilogM Doc)
-> [Natural] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Natural -> SystemVerilogM Doc
forall {a}. Integral a => a -> SystemVerilogM Doc
el [Natural]
es)

expr_ Bool
_ (DataCon (RTree Int
0 HWType
elTy) Modifier
_ [Expr
e]) = SystemVerilogM Doc
"'" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
elTy Expr
e)

expr_ Bool
_ e :: Expr
e@(DataCon ty :: HWType
ty@(RTree Int
_ HWType
elTy) Modifier
_ [Expr
e1,Expr
e2]) = case Expr -> Maybe [Expr]
rtreeChain Expr
e of
  Just [Expr]
es -> SystemVerilogM Doc
"'" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((Expr -> SystemVerilogM Doc)
-> [Expr] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
elTy) [Expr]
es)
  Maybe [Expr]
Nothing -> HWType -> SystemVerilogM Doc
verilogTypeMark HWType
ty SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_br" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e1 SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e2)

expr_ Bool
_ (DataCon (SP {}) (DC (BitVector Int
_,Int
_)) [Expr]
es) = SystemVerilogM Doc
assignExpr
  where
    argExprs :: [SystemVerilogM Doc]
argExprs   = (Expr -> SystemVerilogM Doc) -> [Expr] -> [SystemVerilogM Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False) [Expr]
es
    assignExpr :: SystemVerilogM Doc
assignExpr = SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma (Ap (State SystemVerilogState) [Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [SystemVerilogM Doc]
argExprs)

expr_ Bool
_ (DataCon ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) = SystemVerilogM Doc
assignExpr
  where
    argTys :: [HWType]
argTys     = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Text, [HWType])]
args [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => [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 a. Num a => [a] -> a
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 :: SystemVerilogM Doc
dcExpr     = Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False (HWType -> Int -> Expr
dcToExpr HWType
ty Int
i)
    argExprs :: [SystemVerilogM Doc]
argExprs   = (HWType -> Expr -> SystemVerilogM Doc)
-> [HWType] -> [Expr] -> [SystemVerilogM Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith HWType -> Expr -> SystemVerilogM Doc
toSLV [HWType]
argTys [Expr]
es
    extraArg :: [SystemVerilogM 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 -> [Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'b" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Lens' SystemVerilogState (Maybe (Maybe Int))
-> [Bit] -> SystemVerilogM Doc
forall s. Lens' s (Maybe (Maybe Int)) -> [Bit] -> Ap (State s) Doc
bits (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> SystemVerilogState -> f SystemVerilogState
Lens' SystemVerilogState (Maybe (Maybe Int))
undefValue (Int -> Bit -> [Bit]
forall a. Int -> a -> [a]
replicate Int
n Bit
U)]
    assignExpr :: SystemVerilogM Doc
assignExpr = SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc)
-> Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ SystemVerilogM Doc
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma (Ap (State SystemVerilogState) [Doc]
 -> Ap (State SystemVerilogState) [Doc])
-> Ap (State SystemVerilogState) [Doc]
-> Ap (State SystemVerilogState) [Doc]
forall a b. (a -> b) -> a -> b
$ [SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence (SystemVerilogM Doc
dcExprSystemVerilogM Doc -> [SystemVerilogM Doc] -> [SystemVerilogM Doc]
forall a. a -> [a] -> [a]
:[SystemVerilogM Doc]
argExprs [SystemVerilogM Doc]
-> [SystemVerilogM Doc] -> [SystemVerilogM Doc]
forall a. [a] -> [a] -> [a]
++ [SystemVerilogM Doc]
extraArg))

expr_ Bool
_ (DataCon ty :: HWType
ty@(Sum Text
_ [Text]
_) (DC (HWType
_,Int
i)) []) = Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'d" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i
expr_ Bool
_ (DataCon ty :: HWType
ty@(CustomSum Text
_ DataRepr'
_ Int
_ [(ConstrRepr', Text)]
tys) (DC (HWType
_,Int
i)) []) =
  let (ConstrRepr' Text
_ Int
_ Integer
_ Integer
value [Integer]
_) = (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a, b) -> a
fst ((ConstrRepr', Text) -> ConstrRepr')
-> (ConstrRepr', Text) -> ConstrRepr'
forall a b. (a -> b) -> a -> b
$ [(ConstrRepr', Text)]
tys [(ConstrRepr', Text)] -> Int -> (ConstrRepr', Text)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (HWType -> Int
typeSize HWType
ty) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
squote SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"d" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
value)
expr_ Bool
_ (DataCon (CustomSP Text
_ DataRepr'
dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
args) (DC (HWType
_,Int
i)) [Expr]
es) =
  let (ConstrRepr'
cRepr, Text
_, [HWType]
argTys) = [(ConstrRepr', Text, [HWType])]
args [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in
  DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> SystemVerilogM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipEqual [HWType]
argTys [Expr]
es)
expr_ Bool
_ (DataCon (CustomProduct Text
_ DataRepr'
dataRepr Int
_size Maybe [Text]
_labels [(Integer, HWType)]
tys) Modifier
_ [Expr]
es) |
  DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr =
  DataRepr' -> ConstrRepr' -> [(HWType, Expr)] -> SystemVerilogM Doc
customReprDataCon DataRepr'
dataRepr ConstrRepr'
cRepr ([HWType] -> [Expr] -> [(HWType, Expr)]
forall a b. HasCallStack => [a] -> [b] -> [(a, b)]
zipEqual (((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd [(Integer, HWType)]
tys) [Expr]
es)

expr_ Bool
_ (DataCon (Product Text
_ Maybe [Text]
_ [HWType]
tys) Modifier
_ [Expr]
es) = Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ((HWType -> Expr -> SystemVerilogM Doc)
-> [HWType] -> [Expr] -> Ap (State SystemVerilogState) [Doc]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM HWType -> Expr -> SystemVerilogM Doc
toSLV [HWType]
tys [Expr]
es)

expr_ Bool
_ (DataCon (Enable Text
_) Modifier
_ [Expr
e]) =
  Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Signed.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Signed (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Unsigned.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) Literal
i

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ (NumLit Integer
m), Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) (Integer -> Integer -> Literal
BitVecLit Integer
m Integer
i)

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger##"
  , [Literal Maybe (HWType, Int)
_ Literal
m, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , NumLit Integer
m' <- Literal
m
  , NumLit Integer
i' <- Literal
i
  = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((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
$ Integer -> Integer -> Bit
toBit Integer
m' Integer
i')

expr_ Bool
_ (BlackBoxE Text
pNm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_)
  | Text
pNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Index.fromInteger#"
  , [Literal Maybe (HWType, Int)
_ (NumLit Integer
n), Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
  , Just Int
k <- Integer -> Integer -> Maybe Int
clogBase Integer
2 Integer
n
  , let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k
  = Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV ((HWType, Int) -> Maybe (HWType, Int)
forall a. a -> Maybe a
Just (Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n),Int
k')) Literal
i

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

expr_ Bool
_ (DataTag HWType
Bool (Left Identifier
id_))          = Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
0)
expr_ Bool
_ (DataTag HWType
Bool (Right Identifier
id_))         = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  SystemVerilogM Doc
"$unsigned" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Ap (State SystemVerilogState) [Doc] -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces ([SystemVerilogM Doc] -> Ap (State SystemVerilogState) [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int (Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces SystemVerilogM Doc
"1'b0"),Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_]))

expr_ Bool
_ (DataTag (Sum Text
_ [Text]
_) (Left Identifier
id_))     = SystemVerilogM Doc
"$unsigned" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)
expr_ Bool
_ (DataTag (Sum Text
_ [Text]
_) (Right Identifier
id_))    = SystemVerilogM Doc
"$unsigned" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_)

expr_ Bool
_ (DataTag (Product {}) (Right Identifier
_))  = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'sd0"

expr_ Bool
_ (DataTag hty :: HWType
hty@(SP Text
_ [(Text, [HWType])]
_) (Right Identifier
id_)) = SystemVerilogM Doc
"$unsigned" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens
                                               (Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Identifier
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets
                                               (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
  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 SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'sd0"
expr_ Bool
_ (DataTag (Vector Int
_ HWType
_) (Right Identifier
_)) = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'sd1"

expr_ Bool
_ (DataTag (RTree Int
0 HWType
_) (Right Identifier
_)) = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'sd0"
expr_ Bool
_ (DataTag (RTree Int
_ HWType
_) (Right Identifier
_)) = do
  Int
iw <- State SystemVerilogState Int -> Ap (State SystemVerilogState) Int
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Int -> Ap (State SystemVerilogState) Int)
-> State SystemVerilogState Int
-> Ap (State SystemVerilogState) Int
forall a b. (a -> b) -> a -> b
$ Getting Int SystemVerilogState Int -> State SystemVerilogState Int
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Int SystemVerilogState Int
Lens' SystemVerilogState Int
intWidth
  Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
iw SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"'sd1"

expr_ Bool
b (ToBv Maybe Identifier
topM HWType
t Expr
e) = do
  Text
nm <- State SystemVerilogState Text -> Ap (State SystemVerilogState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Text
 -> Ap (State SystemVerilogState) Text)
-> State SystemVerilogState Text
-> Ap (State SystemVerilogState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text SystemVerilogState Text
-> State SystemVerilogState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text SystemVerilogState Text
Lens' SystemVerilogState Text
modNm
  Bool
pkgCtx <- State SystemVerilogState Bool -> Ap (State SystemVerilogState) Bool
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Bool
 -> Ap (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Ap (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> State SystemVerilogState Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
tyPkgCtx
  let prefix :: SystemVerilogM Doc
prefix = if Bool
pkgCtx then SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
nm SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::"
  case HWType
t of
    Vector {} -> do
      State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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)
      SystemVerilogM Doc
-> (Identifier -> SystemVerilogM Doc)
-> Maybe Identifier
-> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc
prefix ((SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Identifier -> SystemVerilogM Doc)
-> Identifier
-> SystemVerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
topM SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        HWType -> SystemVerilogM Doc
tyName HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e)
    RTree {} -> do
      State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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)
      SystemVerilogM Doc
-> (Identifier -> SystemVerilogM Doc)
-> Maybe Identifier
-> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc
prefix ((SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Identifier -> SystemVerilogM Doc)
-> Identifier
-> SystemVerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
topM SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        HWType -> SystemVerilogM Doc
tyName HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e)
    HWType
_ -> Bool -> Expr -> SystemVerilogM Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
b Expr
e

expr_ Bool
b (FromBv Maybe Identifier
topM HWType
t Expr
e) = do
  Text
nm <- State SystemVerilogState Text -> Ap (State SystemVerilogState) Text
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Text
 -> Ap (State SystemVerilogState) Text)
-> State SystemVerilogState Text
-> Ap (State SystemVerilogState) Text
forall a b. (a -> b) -> a -> b
$ Getting Text SystemVerilogState Text
-> State SystemVerilogState Text
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Text SystemVerilogState Text
Lens' SystemVerilogState Text
modNm
  Bool
pkgCtx <- State SystemVerilogState Bool -> Ap (State SystemVerilogState) Bool
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (State SystemVerilogState Bool
 -> Ap (State SystemVerilogState) Bool)
-> State SystemVerilogState Bool
-> Ap (State SystemVerilogState) Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool SystemVerilogState Bool
-> State SystemVerilogState Bool
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting Bool SystemVerilogState Bool
Lens' SystemVerilogState Bool
tyPkgCtx
  let prefix :: SystemVerilogM Doc
prefix = if Bool
pkgCtx then SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
emptyDoc else Text -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
stringS Text
nm SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::"
  case HWType
t of
    Vector {} -> do
      State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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)
      SystemVerilogM Doc
-> (Identifier -> SystemVerilogM Doc)
-> Maybe Identifier
-> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc
prefix ((SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Identifier -> SystemVerilogM Doc)
-> Identifier
-> SystemVerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
topM SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        HWType -> SystemVerilogM Doc
tyName HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e)
    RTree {} -> do
      State SystemVerilogState () -> Ap (State SystemVerilogState) ()
forall {k} (f :: k -> Type) (a :: k). f a -> Ap f a
Ap ((HashSet HWType -> Identity (HashSet HWType))
-> SystemVerilogState -> Identity SystemVerilogState
Lens' SystemVerilogState (HashSet HWType)
tyCache ((HashSet HWType -> Identity (HashSet HWType))
 -> SystemVerilogState -> Identity SystemVerilogState)
-> (HashSet HWType -> HashSet HWType)
-> State SystemVerilogState ()
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)
      SystemVerilogM Doc
-> (Identifier -> SystemVerilogM Doc)
-> Maybe Identifier
-> SystemVerilogM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SystemVerilogM Doc
prefix ((SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_types::") (SystemVerilogM Doc -> SystemVerilogM Doc)
-> (Identifier -> SystemVerilogM Doc)
-> Identifier
-> SystemVerilogM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty) Maybe Identifier
topM SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<>
        HWType -> SystemVerilogM Doc
tyName HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e)
    HWType
_ -> Bool -> Expr -> SystemVerilogM Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
b Expr
e

expr_ Bool
b (IfThenElse Expr
c Expr
t Expr
e) =
  Bool -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (m :: Type -> Type). Monad m => Bool -> m Doc -> m Doc
parenIf Bool
b (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
c SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
"?" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> SystemVerilogM Doc
":" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
True Expr
e)

expr_ Bool
_ Expr
e = [Char] -> SystemVerilogM Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> SystemVerilogM Doc) -> [Char] -> SystemVerilogM Doc
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Expr -> [Char]
forall a. Show a => a -> [Char]
show Expr
e) -- empty

exprLitSV :: Maybe (HWType,Size) -> Literal -> SystemVerilogM Doc
exprLitSV :: Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
exprLitSV = Lens' SystemVerilogState (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> SystemVerilogM Doc
forall s.
Backend s =>
Lens' s (Maybe (Maybe Int))
-> Maybe (HWType, Int) -> Literal -> Ap (State s) Doc
exprLit (Maybe (Maybe Int) -> f (Maybe (Maybe Int)))
-> SystemVerilogState -> f SystemVerilogState
Lens' SystemVerilogState (Maybe (Maybe Int))
undefValue

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
0 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 a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
A.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

toSLV :: HWType -> Expr -> SystemVerilogM Doc
toSLV :: HWType -> Expr -> SystemVerilogM Doc
toSLV HWType
t Expr
e = case HWType
t of
  Vector Int
_ HWType
_ -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e))
  RTree Int
_ HWType
_ -> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
braces (HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_to_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e))
  MemBlob Int
n Int
m -> HWType -> Expr -> SystemVerilogM Doc
toSLV (Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m)) Expr
e
  HWType
_ -> Bool -> Expr -> SystemVerilogM Doc
expr_ Bool
False Expr
e

fromSLV :: HWType -> IdentifierText -> Int -> Int -> SystemVerilogM Doc
fromSLV :: HWType -> Text -> Int -> Int -> SystemVerilogM Doc
fromSLV t :: HWType
t@(Vector Int
_ HWType
_) Text
id_ Int
start Int
end = HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
fromSLV t :: HWType
t@(RTree Int
_ HWType
_) Text
id_ Int
start Int
end = HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
fromSLV (Signed Int
_) Text
id_ Int
start Int
end = SystemVerilogM Doc
"$signed" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end))
fromSLV (MemBlob Int
n Int
m) Text
id_ Int
start Int
end = HWType -> Text -> Int -> Int -> SystemVerilogM Doc
fromSLV (Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m)) Text
id_ Int
start Int
end
fromSLV HWType
_ Text
id_ Int
start Int
end = Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_ SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
start SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => f Doc
colon SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> Int -> SystemVerilogM Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
end)

simpleFromSLV :: HWType -> IdentifierText -> SystemVerilogM Doc
simpleFromSLV :: HWType -> Text -> SystemVerilogM Doc
simpleFromSLV t :: HWType
t@(Vector Int
_ HWType
_) Text
id_ = HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
simpleFromSLV t :: HWType
t@(RTree Int
_ HWType
_) Text
id_ = HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
simpleFromSLV (Signed Int
_) Text
id_ = SystemVerilogM Doc
"$signed" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens (Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_)
simpleFromSLV (MemBlob Int
n Int
m) Text
id_ = HWType -> Text -> SystemVerilogM Doc
simpleFromSLV (Int -> HWType -> HWType
Vector Int
n (Int -> HWType
BitVector Int
m)) Text
id_
simpleFromSLV HWType
_ Text
id_ = Text -> SystemVerilogM Doc
forall (f :: Type -> Type) a.
(Applicative f, Pretty a) =>
a -> f Doc
pretty Text
id_

expFromSLV :: HWType -> SystemVerilogM Doc -> SystemVerilogM Doc
expFromSLV :: HWType -> SystemVerilogM Doc -> SystemVerilogM Doc
expFromSLV t :: HWType
t@(Vector Int
_ HWType
_) SystemVerilogM Doc
exp_ = HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
exp_
expFromSLV t :: HWType
t@(RTree Int
_ HWType
_) SystemVerilogM Doc
exp_ = HWType -> SystemVerilogM Doc
verilogTypeMark HWType
t SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc
"_from_lv" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
exp_
expFromSLV (Signed Int
_) SystemVerilogM Doc
exp_ = SystemVerilogM Doc
"$signed" SystemVerilogM Doc -> SystemVerilogM Doc -> SystemVerilogM Doc
forall a. Semigroup a => a -> a -> a
<> SystemVerilogM Doc -> SystemVerilogM Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
parens SystemVerilogM Doc
exp_
expFromSLV HWType
_ SystemVerilogM Doc
exp_ = SystemVerilogM Doc
exp_

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)) (Integer -> Literal
NumLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i))

listBraces :: Monad m => m [Doc] -> m Doc
listBraces :: forall (m :: Type -> Type). Monad m => m [Doc] -> m Doc
listBraces = m Doc -> m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
align (m Doc -> m Doc) -> (m [Doc] -> m Doc) -> m [Doc] -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Doc -> m Doc -> m Doc -> m [Doc] -> m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep m Doc
forall (f :: Type -> Type). Applicative f => f Doc
lbrace m Doc
forall (f :: Type -> Type). Applicative f => f Doc
rbrace m Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma

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

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


data NMod
  = NRange Int Int
  | NElem Int

-- | Calculate the beginning and end index into a variable, to get the
-- desired field. Also returns the HWType of the result.
--
-- NB: returns a list of slices and indices when selections are into vectors and
-- rtrees. Left -> index/slice from an unpacked array; Right -> slice from a
-- packed type
modifier
  :: Int
  -- ^ Offset, only used when we have nested modifiers
  -> [Either NMod NMod]
  -- ^ Ranges selected so far
  -> Modifier
  -> Maybe ([Either NMod NMod],HWType)
modifier :: Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
offset [Either NMod NMod]
mods (Sliced (BitVector Int
_,Int
start,Int
end)) =
  let m :: Either a NMod
m = NMod -> Either a NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset)) in
  case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, 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))
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods, 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))

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
args),Int
dcI,Int
fI)) =
  case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
argTy)
  where
    argTys :: [HWType]
argTys   = (Text, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd ((Text, [HWType]) -> [HWType]) -> (Text, [HWType]) -> [HWType]
forall a b. (a -> b) -> a -> b
$ [(Text, [HWType])]
args [(Text, [HWType])] -> Int -> (Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
dcI
    argTy :: HWType
argTy    = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize  = HWType -> Int
typeSize HWType
argTy
    other :: Int
other    = [HWType] -> Int -> Int
otherSize [HWType]
argTys (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
-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
    m :: Either a NMod
m        = NMod -> Either a NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset))

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Product Text
_ Maybe [Text]
_ [HWType]
argTys),Int
_,Int
fI)) =
  let m :: Either a NMod
m = NMod -> Either a NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset)) in
  case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
argTy)
  where
    argTy :: HWType
argTy   = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI
    argSize :: Int
argSize = HWType -> Int
typeSize HWType
argTy
    otherSz :: Int
otherSz = [HWType] -> Int -> Int
otherSize [HWType]
argTys (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

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
1,Int
0)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    Left (NRange Int
b Int
_):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem Int
b)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest,HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem Int
0)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
argTy)
  where
    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

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Vector Int
n HWType
argTy),Int
1,Int
1)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) Int
offset)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
    Left (NRange Int
b Int
e):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> Int -> NMod
NRange (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
e)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> Int -> NMod
NRange Int
1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods, Int -> HWType -> HWType
Vector (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
  where
    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

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(RTree Int
0 HWType
argTy),Int
0,Int
0)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) Int
offset)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    Left (NRange Int
b Int
_):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem Int
b)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest,HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem Int
0)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
argTy)
  where
    start :: Int
start   = HWType -> Int
typeSize HWType
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
0)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
    Left (NRange Int
b Int
_):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> Int -> NMod
NRange Int
b (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lhsSzInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest,Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> Int -> NMod
NRange Int
0 (Int
lhsSzInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
  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. Integral a => a -> a -> a
`div` Int
2
    lhsSz :: Int
lhsSz   = (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2 :: Int)

modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(RTree Int
d HWType
argTy),Int
1,Int
1)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) Int
offset)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, Int -> HWType -> HWType
RTree  (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
    Left (NRange Int
_ Int
e):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> Int -> NMod
NRange (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rhsS) Int
e)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest,Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> Int -> NMod
NRange Int
rhsS Int
rhsE)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,Int -> HWType -> HWType
RTree (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) HWType
argTy)
  where
    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
    rhsS :: Int
rhsS    = (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2 :: Int)
    rhsE :: Int
rhsE    = Int
dInt -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2 :: Int)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- Vector's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(Vector Int
_ HWType
argTy),Int
10,Int
fI)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    Left (NRange Int
b Int
_):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem (Int
fIInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem Int
fI)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
argTy)
  where
    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

-- This is a HACK for Clash.Netlist.Util.mkTopOutput
-- RTree's don't have a 10'th constructor, this is just so that we can
-- recognize the particular case
modifier Int
offset [Either NMod NMod]
mods (Indexed (ty :: HWType
ty@(RTree Int
_ HWType
argTy),Int
10,Int
fI)) = case [Either NMod NMod]
mods of
    Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    Left (NRange Int
b Int
_):[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
fI))Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
    [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (NMod -> Either NMod NMod
forall a b. a -> Either a b
Left (Int -> NMod
NElem Int
fI)Either NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods, HWType
argTy)
  where
    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

modifier Int
offset [Either NMod NMod]
mods (Indexed (CustomSP Text
typName DataRepr'
_dataRepr Int
_size [(ConstrRepr', Text, [HWType])]
args,Int
dcI,Int
fI)) =
  case Integer -> [(Int, Int)]
bitRanges ([Integer]
anns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI) of
    [(Int
start,Int
end)] ->
      let m :: Either a NMod
m = NMod -> Either a NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset)) in
      case [Either NMod NMod]
mods of
        Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
        [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods, HWType
argTy)
    [(Int, Int)]
_ ->
      [Char] -> Maybe ([Either NMod NMod], HWType)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe ([Either NMod NMod], HWType))
-> [Char] -> Maybe ([Either NMod NMod], HWType)
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Cannot handle projection out of a "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"non-contiguously or zero-width encoded field. Tried to project "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"field " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fI [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" of constructor " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
dcI [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" of "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"data type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
typName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  [Char]
"."
 where
  (ConstrRepr' Text
_name Int
_n Integer
_mask Integer
_value [Integer]
anns, Text
_, [HWType]
argTys) = [(ConstrRepr', Text, [HWType])]
args [(ConstrRepr', Text, [HWType])]
-> Int -> (ConstrRepr', Text, [HWType])
forall a. HasCallStack => [a] -> Int -> a
!! Int
dcI
  argTy :: HWType
argTy = [HWType]
argTys [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI

modifier Int
offset [Either NMod NMod]
mods (Indexed (CustomProduct Text
typName DataRepr'
dataRepr Int
_size Maybe [Text]
_maybeFieldNames [(Integer, HWType)]
args,Int
dcI,Int
fI))
  | DataRepr' Type'
_typ Int
_size [ConstrRepr'
cRepr] <- DataRepr'
dataRepr
  , ConstrRepr' Text
_cName Int
_pos Integer
_mask Integer
_val [Integer]
fieldAnns <- ConstrRepr'
cRepr =
  case Integer -> [(Int, Int)]
bitRanges ([Integer]
fieldAnns [Integer] -> Int -> Integer
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI) of
    [(Int
start,Int
end)] ->
      let m :: Either a NMod
m = NMod -> Either a NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset)) in
      case [Either NMod NMod]
mods of
        Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
argTy)
        [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
argTy)
    [(Int, Int)]
_ ->
      [Char] -> Maybe ([Either NMod NMod], HWType)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe ([Either NMod NMod], HWType))
-> [Char] -> Maybe ([Either NMod NMod], HWType)
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Cannot handle projection out of a "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"non-contiguously or zero-width encoded field. Tried to project "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"field " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fI [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" of constructor " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
dcI [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" of "
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"data type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
typName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
 where
  argTy :: HWType
argTy = ((Integer, HWType) -> HWType) -> [(Integer, HWType)] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, HWType) -> HWType
forall a b. (a, b) -> b
snd [(Integer, HWType)]
args [HWType] -> Int -> HWType
forall a. HasCallStack => [a] -> Int -> a
!! Int
fI

modifier Int
offset [Either NMod NMod]
mods (DC (ty :: HWType
ty@(SP Text
_ [(Text, [HWType])]
_),Int
_)) =
    let m :: Either a NMod
m = NMod -> Either a NMod
forall a b. b -> Either a b
Right (Int -> Int -> NMod
NRange (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset)) in
    case [Either NMod NMod]
mods of
      Right {}:[Either NMod NMod]
rest -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
rest, HWType
ty)
      [Either NMod NMod]
_ -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just (Either NMod NMod
forall {a}. Either a NMod
mEither NMod NMod -> [Either NMod NMod] -> [Either NMod NMod]
forall a. a -> [a] -> [a]
:[Either NMod NMod]
mods,HWType
ty)
  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

modifier Int
offset [Either NMod NMod]
mods (Nested Modifier
m1 Modifier
m2) = do
  case Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
offset [Either NMod NMod]
mods Modifier
m1 of
    Maybe ([Either NMod NMod], HWType)
Nothing -> Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
offset [Either NMod NMod]
mods Modifier
m2
    Just ([Either NMod NMod]
mods1,HWType
argTy) ->
      let m3 :: Maybe ([Either NMod NMod], HWType)
m3 = case [Either NMod NMod]
mods1 of
                 Right (NRange Int
_ Int
e):[Either NMod NMod]
_ -> Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
e [Either NMod NMod]
mods1 Modifier
m2
                 [Either NMod NMod]
_ -> Int
-> [Either NMod NMod]
-> Modifier
-> Maybe ([Either NMod NMod], HWType)
modifier Int
0 [Either NMod NMod]
mods1 Modifier
m2
      in case Maybe ([Either NMod NMod], HWType)
m3 of
        -- In case the second modifier is `Nothing` that means we want the entire
        -- thing calculated by the first modifier
        Maybe ([Either NMod NMod], HWType)
Nothing -> ([Either NMod NMod], HWType) -> Maybe ([Either NMod NMod], HWType)
forall a. a -> Maybe a
Just ([Either NMod NMod]
mods1,HWType
argTy)
        Maybe ([Either NMod NMod], HWType)
m       -> Maybe ([Either NMod NMod], HWType)
m

modifier Int
_ [Either NMod NMod]
_ Modifier
_ = Maybe ([Either NMod NMod], HWType)
forall a. Maybe a
Nothing